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

Annotation of /FigWebServices/ss_export.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.8 - (view) (download)

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3