[Bio] / FigWebServices / ss_export.cgi Repository:
ViewVC logotype

Annotation of /FigWebServices/ss_export.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.7 - (view) (download)

1 : olson 1.1 use FIG;
2 :     use CGI;
3 :     use HTML;
4 :    
5 :     use List::Util;
6 :     use File::Spec;
7 :     use strict;
8 :    
9 :     my $cgi = new CGI;
10 :     my $fig = new FIG();
11 :    
12 :     my $user = $cgi->param("user");
13 :     my $subsystem = $cgi->param("ssa_name");
14 :    
15 :     my $html = [];
16 :    
17 :     #
18 :     # Decide what to do.
19 :     #
20 :     # If button_export is set, we're doing an export.
21 :     #
22 :     # Otherwise we're just updating the page.
23 :     #
24 :    
25 :     if ($cgi->param("export_button"))
26 :     {
27 :     my $sub = $fig->get_subsystem($subsystem);
28 :    
29 :     my(@roles, @genomes);
30 :    
31 :     for my $p ($cgi->param)
32 :     {
33 :    
34 :     if ($p =~ /export_genome_(\d+)/)
35 :     {
36 :     push(@genomes, $1);
37 :     }
38 :     elsif ($p =~ /export_role_(\d+)/)
39 :     {
40 :     push(@roles, $1);
41 :     }
42 :     }
43 :    
44 :    
45 :     #
46 :     # We will export a file for each genome (for each selected subsystem),
47 :     # for each subsystem (for each selected genome),
48 :     # and for all selected sequences.
49 :     #
50 :    
51 :     my $tmp = File::Spec->catfile($FIG_Config::temp, "export_$$");
52 :     &FIG::verify_dir($tmp);
53 :    
54 :     chdir($tmp);
55 :    
56 :     #
57 : olson 1.5 # Write a README with the mapping from genome and role index to name.
58 :     #
59 :    
60 :     open(my $rfh, ">README");
61 :    
62 :     print $rfh "Roles\n";
63 :     for my $role (@roles)
64 :     {
65 :     my $name = $sub->get_role($role);
66 :     my $abbr = $sub->get_role_abbr($role);
67 :    
68 :     print $rfh "$role\t$abbr\t$name\n";
69 :     }
70 :    
71 :     print $rfh "\n";
72 :    
73 :     print $rfh "Genomes\n";
74 :    
75 :     for my $g (@genomes)
76 :     {
77 :     my $gname = $sub->get_genome($g);
78 :     my $gs = $fig->genus_species($gname);
79 :    
80 :     print $rfh "$g\t$gname\t$gs\n";
81 :     }
82 :     close($rfh);
83 :    
84 :     #
85 : olson 1.1 # Write the role exports.
86 :     #
87 :    
88 :     for my $role (@roles)
89 :     {
90 : olson 1.2 my $file = "role_$role.dna.fasta";
91 :     my $protfile = "role_$role.prot.fasta";
92 : olson 1.1 open(my $fh, ">$file");
93 : olson 1.2 open(my $protfh, ">$protfile");
94 : olson 1.1 for my $g (@genomes)
95 :     {
96 :     my $gname = $sub->get_genome($g);
97 :     my $entry = $sub->get_cell($g, $role);
98 :     if ($entry)
99 :     {
100 :     for my $peg (@$entry)
101 :     {
102 : olson 1.7 my $pegname = $peg;
103 :     $pegname =~ s/^fig\|//;
104 :     $pegname =~ s/\.peg\././;
105 :    
106 : olson 1.1 my @location = $fig->feature_location($peg);
107 :     if (@location > 0)
108 :     {
109 :     my $seq = $fig->dna_seq($gname, @location);
110 : olson 1.6 if ($seq ne "")
111 :     {
112 : olson 1.7 &FIG::display_id_and_seq($pegname, \$seq, $fh);
113 : olson 1.6 }
114 : olson 1.1 }
115 : olson 1.2 my $seq = $fig->get_translation($peg);
116 : olson 1.6 if ($seq ne "")
117 :     {
118 : olson 1.7 &FIG::display_id_and_seq($pegname, \$seq, $protfh);
119 : olson 1.6 }
120 : olson 1.1 }
121 :     }
122 :     }
123 :     close($fh);
124 : olson 1.2 close($protfh);
125 : olson 1.1 }
126 :    
127 :     #
128 :     # Write the genome exports, and while we're at it, write the
129 :     # all-sequences file.
130 :     #
131 :    
132 : olson 1.2 open(my $all_fh, ">all.dna.fasta");
133 :     open(my $allprot_fh, ">all.prot.fasta");
134 :     my $catfile = "all.prot.cat.fasta";
135 :     open(my $catfh, ">$catfile");
136 : olson 1.1
137 :     for my $g (@genomes)
138 :     {
139 :     my $gname = $sub->get_genome($g);
140 : olson 1.2 my $file = "genome_$g.dna.fasta";
141 :     my $protfile = "genome_$g.prot.fasta";
142 : olson 1.1
143 :     open(my $fh, ">$file");
144 : olson 1.2 open(my $protfh, ">$protfile");
145 :     print $catfh ">$gname/" . $fig->genus_species($gname) . "\n";
146 : olson 1.1 for my $role (@roles)
147 :     {
148 :     my $entry = $sub->get_cell($g, $role);
149 :     if ($entry)
150 :     {
151 :     for my $peg (@$entry)
152 :     {
153 : olson 1.7 my $pegname = $peg;
154 :     $pegname =~ s/^fig\|//;
155 :     $pegname =~ s/\.peg\././;
156 : olson 1.1 my @location = $fig->feature_location($peg);
157 :     if (@location > 0)
158 :     {
159 :     my $seq = $fig->dna_seq($gname, @location);
160 : olson 1.6 if ($seq ne "")
161 :     {
162 : olson 1.7 &FIG::display_id_and_seq($pegname, \$seq, $fh);
163 :     &FIG::display_id_and_seq($pegname, \$seq, $all_fh);
164 : olson 1.6 }
165 : olson 1.1 }
166 : olson 1.2 my $seq = $fig->get_translation($peg);
167 : olson 1.6 if ($seq ne "")
168 :     {
169 : olson 1.7 &FIG::display_id_and_seq($pegname, \$seq, $protfh);
170 :     &FIG::display_id_and_seq($pegname, \$seq, $allprot_fh);
171 : olson 1.6 &FIG::display_seq(\$seq, $catfh);
172 :     }
173 : olson 1.1 }
174 :     }
175 :     }
176 :     close($fh);
177 : olson 1.2 close($protfh);
178 : olson 1.1 }
179 : olson 1.2 close($catfh);
180 : olson 1.1 close($all_fh);
181 : olson 1.2 close($allprot_fh);
182 : olson 1.1
183 : olson 1.3 my $outname = "$subsystem.$$.tar.gz";
184 : olson 1.4 $outname =~ s/[^\w.-]/_/g;
185 : olson 1.3
186 :     system("tar czf ../$outname .");
187 :     my $size = (stat("../$outname"))[7];
188 :    
189 : olson 1.1 print "Content-Type: application/octet-stream\n";
190 : olson 1.3 print "Content-Length: $size\n";
191 :     print "Content-Disposition:attachment;filename=$outname\n";
192 : olson 1.1 print "\n";
193 : olson 1.3
194 :     my $buf;
195 :     open(my $myout, "<../$outname");
196 :     while (read($myout, $buf, 4096))
197 :     {
198 :     print $buf;
199 :     }
200 :     close($myout);
201 : olson 1.1
202 :     chdir("..");
203 : olson 1.5 system("rm -r $tmp $outname");
204 : olson 1.1
205 :     exit;
206 :     }
207 :    
208 :     push(@$html, $cgi->start_form(-action => "ss_export.cgi",
209 :     -method => "post"),
210 :     $cgi->hidden(-name => 'user', -value => $user, -override => 1),
211 :     $cgi->hidden(-name => 'ssa_name', -value => $subsystem, -override => 1),
212 :     $cgi->h2("Showing genomes for $subsystem\n"),
213 :     );
214 :    
215 :     #
216 :     # Show the selection list for limiting to family.
217 :     #
218 :    
219 :     my $taxonomic_groups = $fig->taxonomic_groups_of_complete(10);
220 :    
221 :     my @group_names = sort grep { $_ ne "All" } map { $_->[0] } @$taxonomic_groups;
222 :    
223 :     unshift(@group_names, "All");
224 :    
225 :     #
226 :     # Display in a scrolling list.
227 :     #
228 :    
229 :     push(@$html,
230 :     $cgi->h2("Limit genomes shown to group:"),
231 :     $cgi->scrolling_list(-name => 'limit_genome',
232 :     -values => [@group_names],
233 :     -default => "All",
234 :     -size => 5,
235 :     -multiple => 1),
236 :     );
237 :    
238 :    
239 :     #
240 :     # Determine if we're limiting genomes, and only use
241 :     # genomes from that group if we are.
242 :     #
243 :    
244 :     my @limit_genome = $cgi->param("limit_genome");
245 :     my %desired_genomes;
246 :    
247 :     if (grep({$_ eq "All"} @limit_genome))
248 :     {
249 :     @limit_genome = ();
250 :     }
251 :    
252 :     if (@limit_genome)
253 :     {
254 :     for my $limit_genome (@limit_genome)
255 :     {
256 :     my @list = grep({ $_->[0] eq $limit_genome } @$taxonomic_groups);
257 :     for my $litem (@list)
258 :     {
259 :     grep({ $desired_genomes{$_}++ } @{$litem->[1]});
260 :     }
261 :     }
262 :     }
263 :    
264 :     #
265 :     # And submit.
266 :     #
267 :    
268 :     push(@$html,
269 :     $cgi->p,
270 :     $cgi->submit(-label => "Update page",
271 :     -name => 'update_button'),
272 :     $cgi->br,
273 :     $cgi->submit(-label => "Export sequences",
274 :     -name => 'export_button'));
275 :    
276 :     #
277 :     # Build the table.
278 :     #
279 :     # Each row is an organism.
280 :     # Each column is a role.
281 :     #
282 :    
283 :     my $sub = $fig->get_subsystem($subsystem);
284 :    
285 :     my @roles = $sub->get_roles();
286 :     my @genomes;
287 :    
288 :     #
289 :     # Filter genome list based on @limit_genome list.
290 :     #
291 :    
292 :     if (@limit_genome)
293 :     {
294 :     for my $g ($sub->get_genomes())
295 :     {
296 :     push(@genomes, $g) if $desired_genomes{$g};
297 :     }
298 :     }
299 :     else
300 :     {
301 :     @genomes = $sub->get_genomes();
302 :    
303 :     }
304 :    
305 :     #
306 :     # Columns are:
307 :     # 1. Genome id
308 :     # 2. Organism name
309 :     # 3. Export-genome checkbox
310 :     # 4-n. Pegs for role (c-3).
311 :     #
312 :     # Rows are:
313 :     # 1. Headers
314 :     # 2. Export-role checkbox
315 :     # 3-n. Pegs for genome (r-2).
316 :     #
317 :    
318 :     my @col_hdrs = ("Genome", "Organism", "Export", @roles);
319 :    
320 :     my @export_roles = map { $cgi->checkbox(-name => "export_role_$_",
321 :     -checked => 1,
322 :     -value => 1,
323 :     -label => "");
324 :     } 1..@roles;
325 :     unshift(@export_roles, "", "", "");
326 :    
327 :     my @table;
328 :    
329 :     push(@table, \@export_roles);
330 :    
331 :     #
332 :     # Now run thru the genomes.
333 :     #
334 :    
335 :     for my $g (@genomes)
336 :     {
337 :     my $row = [];
338 :    
339 :     my $idx = $sub->get_genome_index($g);
340 :     push(@$row, $g);
341 :     push(@$row, $fig->genus_species($g));
342 :     push(@$row, $cgi->checkbox(-name => "export_genome_$idx",
343 :     -checked => 1,
344 :     -value => 1,
345 :     -label => ""));
346 :     for my $role (@roles)
347 :     {
348 :     #
349 :     # Get the cell from the spreadsheet and put the pegs in here.
350 :     #
351 :    
352 :     my @pegs = $sub->get_pegs_from_cell($idx, $role);
353 :     @pegs = map {
354 :     my $num = (&FIG::genome_and_peg_of($_))[1];
355 :     "<a href=\"protein.cgi?prot=$_&user=$user\">$num</a>"
356 :     } @pegs;
357 :     push(@$row, join(" ", @pegs));
358 :     }
359 :    
360 :     push(@table, $row);
361 :    
362 :     }
363 :    
364 :    
365 :     push(@$html, HTML::make_table(\@col_hdrs, \@table));
366 :    
367 :     push(@$html, $cgi->end_form());
368 :    
369 :    
370 :     &HTML::show_page($cgi, $html);
371 :    
372 :    
373 :     __END__
374 :    
375 :     #
376 :     # Create the table using the sorted list of genome ids.
377 :     #
378 :    
379 :     for my $k (@show_genomes)
380 :     {
381 :     my $c = $all_genomes{$k};
382 :    
383 :     my $row = [];
384 :    
385 :     #
386 :     # Display genome id and name.
387 :     #
388 :     push(@$row, $k);
389 :     push(@$row, &ext_genus_species($fig, $k));
390 :    
391 :     #
392 :     # For each subsystem, look up the variant code and put in the table.
393 :     #
394 :     for my $subname (@display_subs)
395 :     {
396 :     my $sub = $fig->get_subsystem($subname);
397 :     my $vc = $sub->get_variant_code_for_genome($k);
398 :     push(@$row, "\@align=\"center\":$vc");
399 :     }
400 :     push(@table, $row);
401 :     }
402 :    
403 :    
404 :     push(@$html, HTML::make_table(\@col_hdrs, \@table));
405 :    
406 :     push(@$html, $cgi->end_form());
407 :    
408 :     &HTML::show_page($cgi, $html);
409 :    
410 :     sub ext_genus_species {
411 :     my($fig,$genome) = @_;
412 :    
413 :     my $gs = $fig->genus_species($genome);
414 :     my $c = substr($fig->taxonomy_of($genome),0,1);
415 :     return "$gs [$c]";
416 :     }
417 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3