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

Annotation of /FigWebServices/display_subsys.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.30 - (view) (download)

1 : overbeek 1.1 # -*- perl -*-
2 : olson 1.10 #
3 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
4 :     # for Interpretations of Genomes. All Rights Reserved.
5 :     #
6 :     # This file is part of the SEED Toolkit.
7 :     #
8 :     # The SEED Toolkit is free software. You can redistribute
9 :     # it and/or modify it under the terms of the SEED Toolkit
10 :     # Public License.
11 :     #
12 :     # You should have received a copy of the SEED Toolkit Public License
13 :     # along with this program; if not write to the University of Chicago
14 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
15 :     # Genomes at veronika@thefig.info or download a copy from
16 :     # http://www.theseed.org/LICENSE.TXT.
17 :     #
18 :    
19 : parrello 1.9 use CGI;
20 : overbeek 1.13 use CGI::Carp qw(fatalsToBrowser); # this makes debugging a lot easier by throwing errors out to the browser
21 : parrello 1.9
22 :     my $cgi = new CGI;
23 :    
24 :     # Tracing support: must precede FIG object creation and follow CGI creation.
25 :     use Tracer;
26 : parrello 1.21 ETracing($cgi);
27 : overbeek 1.1
28 :     use FIG;
29 : parrello 1.11 use SFXlate;
30 : overbeek 1.1 use FIGjs; # mouseover()
31 : parrello 1.11 # Create a FIG-like object.
32 : parrello 1.29 my $is_sprout = FIGRules::nmpdr_mode($cgi);
33 : olson 1.23
34 :     my $fig;
35 :    
36 :     if ($is_sprout)
37 :     {
38 : parrello 1.30 my $subsys = $cgi->param('ssa_name');
39 :     print $cgi->redirect(-status => 301, -uri => "$FIG_Config::linkinSV?page=Subsystems;subsystem=$subsys");
40 :     exit
41 : olson 1.23 }
42 :     else
43 :     {
44 :     if (my $job = $cgi->param("48hr_job"))
45 :     {
46 :     my $jobdir = "/vol/48-hour/Jobs/$job";
47 :     my $genome = &FIG::file_head("$jobdir/GENOME_ID");
48 :     chomp $genome;
49 :     if ($genome !~ /^\d+\.\d+/)
50 :     {
51 :     die "Cannnot find genome ID for jobdir $jobdir\n";
52 :     }
53 :     my $orgdir = "$jobdir/rp/$genome";
54 :     if (! -d $orgdir)
55 :     {
56 :     die "Cannot find orgdir $orgdir\n";
57 :     }
58 :     $fig = new FIGV($orgdir);
59 :     }
60 :     else
61 :     {
62 :     $fig = FIG->new();
63 :     }
64 :     }
65 : overbeek 1.1
66 :     use Subsystem;
67 :    
68 : olson 1.23 use URI::Escape; # uri_escape()
69 : overbeek 1.1 use HTML;
70 :     use strict;
71 :     use tree_utilities;
72 : parrello 1.18 use TemplateObject;
73 : overbeek 1.1
74 : overbeek 1.13 use raelib;
75 :     my $raelib=new raelib; #this is for the excel workbook stuff.
76 :    
77 :    
78 : overbeek 1.1 if (0)
79 :     {
80 :     my $VAR1;
81 :     eval(join("",`cat /tmp/ssa_parms`));
82 :     $cgi = $VAR1;
83 :     # print STDERR &Dumper($cgi);
84 :     }
85 :    
86 :     if (0)
87 :     {
88 :     print $cgi->header;
89 :     my @params = $cgi->param;
90 :     print "<pre>\n";
91 :     foreach $_ (@params)
92 :     {
93 : parrello 1.7 print "$_\t:",join(",",$cgi->param($_)),":\n";
94 : overbeek 1.1 }
95 :    
96 :     if (0)
97 :     {
98 : parrello 1.7 if (open(TMP,">/tmp/ssa_parms"))
99 :     {
100 :     print TMP &Dumper($cgi);
101 :     close(TMP);
102 :     }
103 : overbeek 1.1 }
104 :     exit;
105 :     }
106 :    
107 : parrello 1.18 my $to = TemplateObject->new($cgi, php => 'Subsystem');
108 : parrello 1.9
109 :    
110 : parrello 1.11 my $dbTitle = $fig->Title();
111 : parrello 1.18 $to->add("<TITLE>$dbTitle Subsystems</TITLE>\n");
112 :    
113 :     my $parameters = { fig_object => $fig,
114 :     table_style => 'plain',
115 :     fig_disk => $FIG_Config::fig_disk . "/",
116 :     form_target => 'display_subsys.cgi'
117 :     };
118 :    
119 :     # Format the header information.
120 :     $to->titles($parameters);
121 :    
122 : overbeek 1.1
123 :     my $ssa = $cgi->param('ssa_name');
124 :     $ssa =~ s/[ \/]/_/g;
125 :    
126 : overbeek 1.5 my $colors = $cgi->param('show_clusters') ? 1 : 0;
127 :     my $aliases = $cgi->param('ext_ids') ? 1 : 0;
128 :     my $active_subsetR = $cgi->param('active_subsetR') || "";
129 :     my $focus = $cgi->param('focus') || "";
130 : overbeek 1.6 my @color = $cgi->param('color');
131 :     my $specific_pegs_to_color = (@color > 0) ? [map { [$_,'#C0C0C0'] } @color] : undef;
132 : hwang 1.15 my %ec2id=();
133 :     my %ec2gofunc=();
134 : parrello 1.9
135 : overbeek 1.1 use UnvSubsys;
136 :    
137 : hwang 1.15
138 : overbeek 1.1 my($subsystem);
139 : parrello 1.18 print $cgi->header();
140 : paczian 1.19 print '<script src="./Html/css/FIG.js" type="text/javascript"></script>';
141 : overbeek 1.5 if ((! $ssa) || (! ($subsystem = new UnvSubsys($ssa,
142 : parrello 1.7 $fig,
143 :     $active_subsetR,
144 :     $focus,
145 :     $colors,
146 :     $aliases,
147 : parrello 1.18 $specific_pegs_to_color)))) {
148 :     $to->add(title => $cgi->h1('You need to specify a subsystem'));
149 :     } else {
150 :     #Load the hash into memory once
151 :     &ec2hash;
152 :     &produce_html_to_display_subsystem($fig,$subsystem,$cgi,$to,$ssa);
153 : overbeek 1.5 }
154 : parrello 1.18
155 :     print $to->finish();
156 :    
157 :     1;
158 : overbeek 1.1
159 :    
160 :     sub produce_html_to_display_subsystem {
161 : parrello 1.18 my($fig,$subsystem,$cgi,$to,$ssa) = @_;
162 : overbeek 1.1
163 :     my $curator = $subsystem->subsystem_curator;
164 :    
165 : parrello 1.18 my $titles = join("\n", $cgi->h1("Subsystem: $ssa"),
166 : parrello 1.7 $cgi->h1("Author: $curator"),
167 : parrello 1.18 "");
168 :     $to->add(title => $titles);
169 :     $to->add($cgi->br);
170 : hwang 1.25
171 : parrello 1.18 &format_roles($fig,$cgi,$to,$subsystem);
172 :    
173 :     my $subsets = &format_subsets($fig,$cgi,$to,$subsystem);
174 : overbeek 1.27 my $pegs_to_download = &format_rows($fig,$cgi,$to,$subsystem);
175 : overbeek 1.1
176 : overbeek 1.4 my $focus = $cgi->param('focus');
177 :     $focus = $focus ? $focus : "";
178 :    
179 :     my $active_subsetR = $cgi->param('active_subsetR');
180 :     $active_subsetR = $active_subsetR ? $active_subsetR : "";
181 :    
182 : parrello 1.18 &format_diagrams($fig,$cgi,$to,$subsystem);
183 : parrello 1.8 Trace("Diagrams generated.") if T(3);
184 : parrello 1.9
185 : overbeek 1.27 my $role_to_download;
186 :     if ($cgi->param('download_fasta') && ($role_to_download = $cgi->param('role_to_download')) && (@$pegs_to_download > 0))
187 :     {
188 :     my $fasta_download = join("\n",($cgi->h2("Fasta for Pegs Implementing $role_to_download"),"<pre>",
189 :     &downloaded_fasta($fig,$cgi,$pegs_to_download),
190 :     "</pre><br><br>\n"));
191 :     $to->add(fasta => $fasta_download);
192 :     }
193 :    
194 : parrello 1.18 my $options = $cgi->h2("Spreadsheet Options");
195 : parrello 1.20 my $sproutValue = $cgi->param("SPROUT") || 0;
196 : parrello 1.18 $options .= join("\n", $cgi->br,
197 : overbeek 1.1 $cgi->start_form(-action => "display_subsys.cgi",
198 : parrello 1.7 -method => 'post'),
199 :     $cgi->hidden(-name => 'ssa_name', -value => $ssa, -override => 1),
200 :     $cgi->hidden(-name => 'focus', -value => $focus, -override => 1),
201 : parrello 1.20 $cgi->hidden(-name => 'SPROUT', -value => $sproutValue, -override => 1),
202 : parrello 1.18 $cgi->br,$cgi->br,
203 :     "");
204 : overbeek 1.1
205 : parrello 1.18 $options .= join("\n", $cgi->scrolling_list(-name => 'active_subsetR',
206 : parrello 1.7 -values => $subsets,
207 :     -default => $active_subsetR,
208 : parrello 1.24 -override => 1,
209 : parrello 1.7 -size => 5
210 :     ),
211 :     $cgi->br,
212 : parrello 1.18 $cgi->br,
213 :     "");
214 : overbeek 1.4
215 : parrello 1.18 $options .= join("\n", $cgi->scrolling_list(-name => 'sort',
216 : parrello 1.7 -value => ['unsorted','alphabetic','by_pattern',
217 :     'by_phylo','by_tax_id','by_variant'],
218 :     -default => 'unsorted'
219 :     ),
220 : parrello 1.18 $cgi->br,$cgi->br,
221 :     "");
222 : overbeek 1.13
223 : parrello 1.18 $options .= join("\n",$cgi->submit('show spreadsheet'),$cgi->br,$cgi->br,$cgi->br,"");
224 : overbeek 1.1
225 : parrello 1.18 $options .= join("\n",$cgi->checkbox(-name => 'ignore_alt', -value => 1, -override => 1, -label => 'Ignore alternatives', -checked => ($cgi->param('ignore_alt'))),$cgi->br,"");
226 :     $options .= join("\n",$cgi->checkbox(-name => 'ext_ids', -value => 1, -checked => 0, -label => 'Use external ids'),$cgi->br,"");
227 :     $options .= join("\n",$cgi->checkbox(-name => 'show_clusters', -value => 1, -checked => 0,-label => 'Show clusters'),$cgi->br,"");
228 :     $options .= join("\n",$cgi->checkbox(-name => 'show_minus1', -value=> 1, -checked => 0, -label => 'Show -1 variants'),$cgi->br,"");
229 : overbeek 1.27
230 :     my $roles_to_pick_from = [sort $subsystem->get_roles];
231 : parrello 1.22 if (! $is_sprout) {
232 : overbeek 1.27
233 :     $options .= join("\n",(
234 :     $cgi->checkbox(-name => 'keep_rep_seqs', -value=> 1, -checked => 0, -label => 'Keep Diverse Sequences'),
235 :     $cgi->textfield(-name=>"how_many_reps", -size => 4, -value => 100), "\n",
236 :     $cgi->scrolling_list(-name => 'role_to_use_for_reps',
237 :     -values => $roles_to_pick_from,
238 :     -size => 1,
239 :     -multiple => 0),
240 :     $cgi->br,""
241 :     ));
242 :    
243 :    
244 : parrello 1.22 if ($cgi->param('create_excel')) {
245 :     $options .= $raelib->excel_file_link() . "\n";
246 :     }
247 :     $options .= join("\n", $cgi->checkbox(-name => 'create_excel', -value=> 1, -checked => 0, -label => 'Create Excel file of these tables'), $cgi->br, "");
248 : overbeek 1.27 $options .= join("\n", (
249 :     $cgi->checkbox(-name => 'download_fasta', -value=> 1, -override => 1, -checked => 0, -label => 'Download Fasta for a Column'),
250 :     $cgi->checkbox(-name => 'mark_questionable', -value=> 1, -checked => 0, -label => 'Mark Questionable PEGs'),
251 :     $cgi->scrolling_list(-name => 'role_to_download',
252 :     -values => $roles_to_pick_from,
253 :     -size => 1,
254 :     -multiple => 0),
255 :     $cgi->br,
256 :     ""));
257 : parrello 1.18 }
258 :     $options .= $cgi->end_form;
259 :     $to->add(options => $options);
260 : overbeek 1.1 my $notes = $subsystem->get_notes();
261 : overbeek 1.13 $notes =~ s/(.{0,80}\s)/$1\n/g; # pre width=80 doesn't work at least in safari. This works.
262 :     $notes =~ s/\n\s*\n/\n\n/g; # this just removes many empty lines (e.g. "\n \n \n \n" matches this regexp)
263 : parrello 1.18 $to->add(notes => $cgi->h2('notes') . "<pre width=80>$notes</pre>");
264 : overbeek 1.1
265 : parrello 1.18 $to->add($cgi->hr);
266 : overbeek 1.1 }
267 :    
268 : hwang 1.15 sub ec2hash {
269 :    
270 : parrello 1.18 open (IN,"$FIG_Config::data/Global/ec2go") or warn $!;
271 : hwang 1.15 my $ec; my $func; my $id;
272 :    
273 :     while ($_ = <IN>) {
274 :     chomp;
275 :    
276 :     $_ =~ /EC:([0-9\-\.]+)\s+\>\s+GO:\s*(\S.*\S)\s*\;\s+GO:(\d+)$/;
277 :     ($ec,$func,$id) = ($1,$2,$3);
278 :     $ec2id{$ec}=$id;
279 :     $ec2gofunc{$ec}=$func;
280 :     }
281 :     close (IN);
282 :    
283 :     }
284 :    
285 :    
286 : parrello 1.8 sub format_diagrams
287 :     {
288 : parrello 1.18 my($fig, $cgi, $to, $subsystem) = @_;
289 : parrello 1.8
290 : parrello 1.18 my $result = "";
291 : parrello 1.8 my @diagrams = $subsystem->get_diagrams();
292 :     my $diagramCount = @diagrams;
293 :     Trace("$diagramCount diagrams found for subsystem.") if T(3);
294 :     if ($diagramCount)
295 :     {
296 : parrello 1.18 $result .= join("\n", $cgi->hr, $cgi->h2("Subsystem Diagrams"), "");
297 : parrello 1.8
298 :     my @hdr = ("Diagram Name");
299 :    
300 :     my @tbl;
301 :     for my $dent (@diagrams)
302 :     {
303 :     my($id, $name, $link) = @$dent;
304 :     Trace("Found diagram $id with name $name linking to $link.") if T(3);
305 :     my @row;
306 :    
307 :     my $js = "showDiagram('$link', '$id'); return false;";
308 :    
309 :     push(@row, qq(<a href="$link" onclick="$js" target="show_ss_diagram_$id">$name</a>));
310 :    
311 :     push(@tbl, \@row);
312 :     }
313 : overbeek 1.14 my %options=(excelfile=>$ssa, no_excel_link=>1);
314 : parrello 1.18 $result .= &HTML::make_table(\@hdr, \@tbl, "", %options);
315 : parrello 1.8 }
316 : parrello 1.18
317 :     $to->add(diagrams => $result);
318 : parrello 1.8
319 :     return $diagramCount > 0;
320 :     }
321 :    
322 :    
323 : overbeek 1.1
324 :     sub format_roles {
325 : parrello 1.18 my($fig,$cgi,$to,$subsystem,$can_alter) = @_;
326 : overbeek 1.1 my($i);
327 :    
328 :     my @roles = $subsystem->get_roles;
329 :     my $reactions = $subsystem->get_reactions;
330 : hwang 1.25
331 :    
332 : overbeek 1.1 my $n = 1;
333 : hwang 1.15 my $col_hdrs = ["Column","Abbrev","Functional Role", "GO"];
334 : overbeek 1.1
335 :     if ($reactions)
336 :     {
337 : parrello 1.7 push(@$col_hdrs,"Reactions");
338 : overbeek 1.1 }
339 :    
340 : hwang 1.25
341 :     push(@$col_hdrs,"Pre-Computed Publication(s)");
342 : hwang 1.26 push(@$col_hdrs,"Relevant Publication(s)");
343 : overbeek 1.1 my $tab = [];
344 :    
345 : parrello 1.18 &format_existing_roles($fig,$cgi,$subsystem,$tab,\$n,$reactions,\@roles);
346 : overbeek 1.14 my %options=(excelfile=>$ssa, no_excel_link=>1);
347 : parrello 1.18 $to->add(roles => &HTML::make_table($col_hdrs,$tab,"Functional Roles", %options) .
348 :     $cgi->hr . "\n");
349 : overbeek 1.1 }
350 :    
351 :     sub format_existing_roles {
352 : parrello 1.18 my($fig,$cgi,$subsystem,$tab,$nP,$reactions,$roles) = @_;
353 : overbeek 1.1 my($role);
354 :    
355 :     foreach $role (@$roles)
356 :     {
357 : parrello 1.18 &format_role($fig,$cgi,$subsystem,$tab,$$nP,$role,$reactions);
358 : parrello 1.7 $$nP++;
359 : overbeek 1.1 }
360 :     }
361 :    
362 :     sub format_role {
363 : parrello 1.18 my($fig,$cgi,$subsystem,$tab,$n,$role,$reactions) = @_;
364 : hwang 1.15 #my($abbrev,$reactT);
365 :     my($abbrev,$reactT,$go,$ec,$golink);
366 : overbeek 1.1
367 :     my $react = $reactions ? join(",", map { &HTML::reaction_link($_) } @{$reactions->{$role}}) : "";
368 : hwang 1.15 ($ec) = ($role =~ /EC\s([0-9\-\.]+)/);
369 : hwang 1.17 if ($ec2id{$ec} ne "") {
370 :     $go = $ec2id{$ec};
371 :     my $go_display = "$ec2gofunc{$ec} \($go\)";
372 :     $golink='<a href="http://www.godatabase.org/cgi-bin/amigo/go.cgi?action=query&view=query&search_constraint=terms&query='.$go.'">'.$go_display.'</a>';
373 :     }
374 :    
375 : overbeek 1.1 $abbrev = $role ? $subsystem->get_role_abbr($subsystem->get_role_index($role)) : "";
376 : hwang 1.17
377 : parrello 1.9
378 : hwang 1.15 my $row = [$n,$abbrev,$role, $golink];
379 : overbeek 1.1 if ($reactions)
380 :     {
381 : parrello 1.7 push(@$row,$react);
382 : overbeek 1.1 }
383 : hwang 1.25
384 : hwang 1.26 my $pre_literature_num = $fig->get_attributes("Role:$role", "ROLE_PUBMED_NOTCURATED");
385 :     my $rel_literature_num = $fig->get_attributes("Role:$role", "ROLE_PUBMED_CURATED_RELEVANT");
386 :    
387 :     if ($pre_literature_num) {
388 :     push(@$row, '<a href="display_role_literature.cgi?subsys='.$ssa.'&role='.$role.'">'.$pre_literature_num.' Publication(s) </a>');
389 : hwang 1.25 }
390 :     else {
391 : hwang 1.26 push (@$row, '');
392 :     }
393 :    
394 :     #This allows the curator to add literature
395 :     if ($rel_literature_num < 1) {
396 :     push(@$row, '<a href="display_role_literature.cgi?subsys='.$ssa.'&role='.$role.'"> Add Publication(s) </a>');
397 :     }
398 :     else {
399 :     push(@$row, '<a href="display_role_literature.cgi?subsys='.$ssa.'&role='.$role.'">'.$rel_literature_num.' Publication(s) </a>');
400 : hwang 1.25 }
401 : overbeek 1.1 push(@$tab,$row);
402 :     }
403 :    
404 :     sub format_subsets {
405 : parrello 1.18 my($fig,$cgi,$to,$subsystem) = @_;
406 : overbeek 1.1
407 : parrello 1.18 &format_subsetsC($fig,$cgi,$to,$subsystem);
408 :     my $subsets = &format_subsetsR($fig,$cgi,$to,$subsystem);
409 : overbeek 1.4 return $subsets;
410 :     }
411 :    
412 :    
413 :     sub tree_link {
414 :     my $target = "window$$";
415 :     my $url = &FIG::cgi_url . "/subsys.cgi?request=show_tree";
416 :     return "<a href=$url target=$target>Show Phylogenetic Tree</a>";
417 :     }
418 :    
419 :     sub format_subsetsR {
420 : parrello 1.18 my($fig,$cgi,$to,$subsystem) = @_;
421 : overbeek 1.4 my($i);
422 :    
423 :     my $link = &tree_link;
424 : parrello 1.18 $to->add(tree_link => $cgi->br . $link . $cgi->br . "\n");
425 : overbeek 1.4
426 : overbeek 1.5 my @row_subs = $subsystem->get_subsetsR;
427 : overbeek 1.4 my $active_subsetR = $cgi->param('active_subsetR');
428 :     my $focus = $cgi->param('focus');
429 :    
430 :     my $subsets = [];
431 :     my $bestN = undef;
432 :     my $bestSz = undef;
433 :    
434 :     my $tuple;
435 :     foreach $tuple (@row_subs)
436 :     {
437 : parrello 1.7 my($id,$genomes) = @$tuple;
438 :     if (! $focus)
439 :     {
440 :     push(@$subsets,$id);
441 :     }
442 :     elsif (&in($focus,$genomes))
443 :     {
444 :     push(@$subsets,$id);
445 :     if ((! $bestN) || (@$genomes < $bestSz))
446 :     {
447 :     $bestN = $id;
448 :     $bestSz = @$genomes;
449 :     }
450 :     }
451 : overbeek 1.4 }
452 :    
453 : parrello 1.9 if ($focus && (! $active_subsetR))
454 : overbeek 1.4 {
455 : parrello 1.7 $active_subsetR = $bestN;
456 :     $cgi->param(-name => 'active_subsetR', -value => $bestN);
457 : overbeek 1.4 }
458 :    
459 :     if (! $active_subsetR)
460 :     {
461 : parrello 1.7 $active_subsetR = 'All';
462 :     $cgi->param(-name => 'active_subsetR', -value => 'All');
463 : overbeek 1.4 }
464 :     return $subsets;
465 :     }
466 :    
467 :     sub in {
468 :     my($x,$xL) = @_;
469 :    
470 :     my $i;
471 :     for ($i=0; ($i < @$xL) && ($xL->[$i] ne $x); $i++) {}
472 :     return ($i < @$xL);
473 : overbeek 1.1 }
474 :    
475 :     sub format_subsetsC {
476 : parrello 1.18 my($fig,$cgi,$to,$subsystem) = @_;
477 : overbeek 1.1
478 :     my $col_hdrs = ["Subset","Includes These Roles"];
479 :     my $tab = [];
480 :    
481 :     my $n = 1;
482 : parrello 1.18 &format_existing_subsetsC($cgi,$subsystem,$tab,\$n);
483 : overbeek 1.1 if ($n > 1)
484 :     {
485 : overbeek 1.14 my %options=(excelfile=>$ssa, no_excel_link=>1);
486 : parrello 1.18 $to->add(subsets => &HTML::make_table($col_hdrs,$tab,"Subsets of Roles", %options) .
487 :     $cgi->hr . "\n");
488 : overbeek 1.1 }
489 :     }
490 :    
491 :     sub format_existing_subsetsC {
492 : parrello 1.18 my($cgi,$subsystem,$tab,$nP) = @_;
493 : overbeek 1.1 my($nameCS);
494 :    
495 :     foreach $nameCS (sort $subsystem->get_subset_namesC)
496 :     {
497 : parrello 1.7 if ($nameCS !~ /all/i)
498 :     {
499 : parrello 1.18 &format_subsetC($cgi,$subsystem,$tab,$$nP,$nameCS);
500 : parrello 1.7 $$nP++;
501 :     }
502 : overbeek 1.1 }
503 :     }
504 :    
505 :     sub format_subsetC {
506 : parrello 1.18 my($cgi,$subsystem,$tab,$n,$nameCS) = @_;
507 : overbeek 1.1
508 :     if ($nameCS ne "All")
509 :     {
510 : parrello 1.7 my $subset = $nameCS ? join(",",map { $subsystem->get_role_index($_) + 1 } $subsystem->get_subsetC_roles($nameCS)) : "";
511 :     $nameCS = $subset ? $nameCS : "";
512 :     push(@$tab,[$nameCS,$subset]);
513 : overbeek 1.1 }
514 :     }
515 :    
516 :     sub format_rows {
517 : parrello 1.18 my($fig,$cgi,$to,$subsystem) = @_;
518 : overbeek 1.1 my($i,%alternatives);
519 : parrello 1.18 my $result = "";
520 : overbeek 1.1 my $ignore_alt = $cgi->param('ignore_alt');
521 : overbeek 1.27 my $pegs_for_selected_role = {};
522 : overbeek 1.1
523 : overbeek 1.4 my $active_subsetR = $cgi->param('active_subsetR');
524 :     my @subsetR = $subsystem->get_subsetR($active_subsetR);
525 :     my %activeR = map { $_ => 1 } @subsetR;
526 : overbeek 1.28 my $focus = $cgi->param('focus');
527 :     if ($focus && (! $activeR{$focus})) { push(@subsetR,$focus); $activeR{$focus} = 1 }
528 : overbeek 1.4
529 : overbeek 1.1 if (! $ignore_alt)
530 :     {
531 : parrello 1.7 my $subset;
532 :     foreach $subset (grep { $_ =~ /^\*/ } $subsystem->get_subset_namesC)
533 :     {
534 :     my @mem = $subsystem->get_subsetC_roles($subset);
535 :     if (@mem > 1)
536 :     {
537 :     my $mem = [@mem];
538 :     foreach $_ (@mem)
539 :     {
540 : overbeek 1.12 $alternatives{$_}->{$subset} = $mem;
541 : parrello 1.7 }
542 :     }
543 :     }
544 : overbeek 1.1 }
545 :     my @in = $subsystem->get_genomes;
546 : parrello 1.9
547 : overbeek 1.1 if (@in > 0)
548 :     {
549 : parrello 1.7 my $col_hdrs = ["Genome ID","Organism","Variant Code"];
550 : overbeek 1.1
551 : parrello 1.7 my @row_guide = ();
552 : overbeek 1.1
553 : overbeek 1.12 my( $role, %in_col, %set_shown, $abbrev, $mem, $abbrev_html );
554 : parrello 1.7 foreach $role ($subsystem->get_roles)
555 :     {
556 : overbeek 1.12 if ( $_ = $alternatives{ $role } )
557 :     {
558 :     my @inA = grep { ! $set_shown{$_} } sort keys(%$_);
559 :     foreach $abbrev (@inA)
560 :     {
561 :     $set_shown{$abbrev} = 1;
562 :     $mem = $_->{$abbrev};
563 :    
564 :     push( @row_guide, [ map { [ $_, "-" . ($subsystem->get_role_index($_) + 1) ] } @$mem ] );
565 :     foreach $_ ( @$mem ) { $in_col{ $_ } = 1 }; # Mark the roles that are done
566 :     my $rolelist = join '<br>', map { substr($_->[1],1) . ". $_->[0]" } @{$row_guide[-1]};
567 :     $abbrev_html = "<a " . FIGjs::mouseover("Roles of $abbrev", $rolelist, '') . ">$abbrev</a>";
568 :     push( @$col_hdrs, $abbrev_html );
569 :     }
570 :     }
571 :     elsif (! $in_col{$role})
572 :     {
573 :     push( @row_guide, [ [ $role, "" ] ] ); # No suffix on peg number
574 :     $abbrev = $subsystem->get_role_abbr( $subsystem->get_role_index( $role ) );
575 :     $abbrev_html = "<a " . FIGjs::mouseover("Role of $abbrev", $role, '') . ">$abbrev</a>";
576 :     push( @$col_hdrs, $abbrev_html );
577 :     }
578 : parrello 1.7 }
579 :    
580 :     my $tab = [];
581 : parrello 1.8 my($genome,@pegs,@cells,$set,$peg_set,$pair,$suffix,$row,$peg,
582 :     $color_of,$cell,%count,$color,@colors);
583 : parrello 1.7
584 :     #
585 :     # Simplified code for checking variants -- GJO
586 :     # If specific variants are requested, make a hash of those to keep:
587 :     #
588 :    
589 : overbeek 1.27 my @active_genomes = grep { $activeR{$_} } @in;
590 :     if ($cgi->param('keep_rep_seqs') && $cgi->param('role_to_use_for_reps') && $cgi->param('how_many_reps'))
591 :     {
592 :     @active_genomes = &take_representative_genomes($fig,
593 :     $subsystem,
594 :     \@active_genomes,
595 :     $cgi->param('role_to_use_for_reps'),
596 :     $cgi->param('how_many_reps')
597 :     );
598 :     }
599 :    
600 :     foreach $genome (@active_genomes)
601 : parrello 1.7 {
602 :     my($genomeV,$vcodeV,$vcode_value);
603 :    
604 :     # Get (and if necessary check) the variant code:
605 :    
606 :     $vcode_value = $subsystem->get_variant_code( $subsystem->get_genome_index( $genome ) );
607 :    
608 :     $row = [ $genome, &ext_genus_species($fig,$genome), $vcode_value ];
609 :    
610 :     @pegs = ();
611 :     @cells = ();
612 :    
613 :     foreach $set (@row_guide)
614 :     {
615 :     $peg_set = [];
616 :     foreach $pair (@$set)
617 :     {
618 :     ($role,$suffix) = @$pair;
619 : overbeek 1.27 my @pegs_in_cell = $subsystem->get_pegs_from_cell($genome,$role);
620 :     my $num_in_cell = @pegs_in_cell;
621 :     foreach $peg (@pegs_in_cell)
622 : parrello 1.7 {
623 : overbeek 1.27 if ($cgi->param('role_to_download') eq $role)
624 :     {
625 :     $pegs_for_selected_role->{$peg} = $num_in_cell;
626 :     }
627 : parrello 1.7 push(@$peg_set,[$peg,$suffix]);
628 :     }
629 :     }
630 :     push(@pegs,map { $_->[0] } @$peg_set);
631 :     push(@cells,$peg_set);
632 :     }
633 :    
634 :     foreach $cell ( @cells ) # $cell = [peg, suffix]
635 :     {
636 :     # Deal with the trivial case (no pegs) at the start
637 : parrello 1.9
638 : parrello 1.7 if ( ! @$cell )
639 :     {
640 :     # Push an empty cell onto the row
641 :    
642 :     push @$row, '@bgcolor="#FFFFFF": &nbsp; ';
643 :     next;
644 :     }
645 :    
646 :     # Figure out html text for each peg and cluster by color.
647 :     my ( $peg, $suffix, $txt, $color );
648 :     my @colors = ();
649 :     my %text_by_color; # Gather like-colored peg text
650 :    
651 :     foreach $_ ( @$cell )
652 :     {
653 :     ( $peg, $suffix ) = @$_;
654 :     # Hyperlink each peg, and add its suffix:
655 :     $txt = ( $cgi->param('ext_ids') ? &ext_url($fig,$cgi,$peg)
656 :     : &HTML::fid_link($cgi,$peg, "local") )
657 :     . ( $suffix ? $suffix : '' );
658 :    
659 :     $color = $subsystem->get_color_of($peg);
660 :     defined( $text_by_color{ $color } ) or push @colors, $color;
661 :     push @{ $text_by_color{ $color } }, $txt;
662 :     }
663 :     my $ncolors = @colors;
664 :     # Join text strings within a color (and remove last comma):
665 :    
666 :     my @str_by_color = map { [ $_, join( ', ', @{ $text_by_color{$_} }, '' ) ] } @colors;
667 :     $str_by_color[-1]->[1] =~ s/, $//;
668 :    
669 :     # Build the "superscript" string:
670 :     my $superscript;
671 :     my $sscript = "";
672 :     if ( $superscript && @$cell )
673 :     {
674 :     my ( %sscript, $ss );
675 :     foreach my $cv ( @$cell ) # Should this be flattened across all pegs?
676 :     {
677 :     next unless ( $ss = $superscript->{ $cv->[0] } );
678 :     # my %flatten = map { ( $_, 1 ) } @$ss;
679 :     # $sscript{ join ",", sort { $a <=> $b } keys %flatten } = 1; # string of all values for peg
680 :     foreach ( @$ss ) { $sscript{ $_ } = 1 }
681 :     }
682 :     if (scalar keys %sscript) # order by number, and format
683 :     {
684 :     my @ss = map { $_->[0] }
685 : parrello 1.9 sort { $a->[1] <=> $b->[1] }
686 : parrello 1.7 map { my ( $num ) = $_ =~ /\>(\d+)\</; [ $_, $num || 0 ] } keys %sscript;
687 :     $sscript = "&nbsp;<sup>[" . join( ", ", @ss ) . "]</sup>"
688 :     }
689 :     }
690 :    
691 :     my $cell_data;
692 :    
693 :     # If there is one color, just write a unicolor cell.
694 :    
695 :     if ( $ncolors == 1 )
696 :     {
697 :     my ( $color, $txt ) = @{ shift @str_by_color };
698 :     $cell_data = qq(\@bgcolor="$color":) . $txt . $sscript;
699 :     }
700 :    
701 :     # Otherwise, write pegs into a subtable with one cell per color.
702 :    
703 :     else
704 :     {
705 :     $cell_data = '<table><tr valign=bottom>'
706 :     . join( '', map { ( $color, $txt ) = @$_ ; qq(<td bgcolor="$color">$txt</td>) } @str_by_color )
707 :     . ( $sscript ? "<td>$sscript</td>" : '' )
708 :     . '</tr></table>';
709 :     }
710 :    
711 :     # Push the cell data onto the row:
712 :    
713 :     push(@$row, $cell_data);
714 :     }
715 :    
716 :     push(@$tab,$row);
717 :     }
718 :    
719 :     my($sort);
720 :     if ($sort = $cgi->param('sort'))
721 :     {
722 :     if ($sort eq "by_pattern")
723 :     {
724 :     my @tmp = ();
725 :     my $row;
726 :     foreach $row (@$tab)
727 :     {
728 :     my @var = ();
729 :     my $i;
730 :     for ($i=3; ($i < @$row); $i++)
731 :     {
732 :     push(@var, ($row->[$i] =~ /\|/) ? 1 : 0);
733 :     }
734 :     push(@tmp,[join("",@var),$row]);
735 :     }
736 :     $tab = [map { $_->[1] } sort { $a->[0] cmp $b->[0] } @tmp];
737 :     }
738 :     elsif ($sort eq "by_phylo")
739 :     {
740 :     $tab = [map { $_->[0] }
741 :     sort { ($a->[1] cmp $b->[1]) or ($a->[0]->[1] cmp $b->[0]->[1]) }
742 :     map { [$_, $fig->taxonomy_of($_->[0])] }
743 :     @$tab];
744 :     }
745 :     elsif ($sort eq "by_tax_id")
746 :     {
747 :     $tab = [sort { $a->[0] <=> $b->[0] } @$tab];
748 :     }
749 :     elsif ($sort eq "alphabetic")
750 :     {
751 :     $tab = [sort { ($a->[1] cmp $b->[1]) or ($a->[0] <=> $b->[0]) } @$tab];
752 :     }
753 :     elsif ($sort eq "by_variant")
754 :     {
755 :     $tab = [sort { ($a->[2] cmp $b->[2]) or ($a->[1] <=> $b->[1]) } @$tab];
756 :     }
757 :     }
758 :    
759 :     foreach $row (@$tab)
760 :     {
761 :     my($genomeV,$vcodeV,$vcode_value);
762 :     $genome = $row->[0];
763 :     $vcode_value = $row->[2];
764 : parrello 1.18 $result .= join("\n",$cgi->hidden(-name => "genome$genome", -value => $genome, -override => 1),
765 :     $cgi->hidden(-name => "vcode$genome", -value => $vcode_value),"");
766 : parrello 1.7 $genomeV = $genome;
767 :     $vcodeV = $vcode_value;
768 :     $row->[0] = $genomeV;
769 :     $row->[2] = $vcodeV;
770 :    
771 :     }
772 :    
773 :     my $tab1 = [];
774 :    
775 :     foreach $row (@$tab)
776 :     {
777 :     next if ($row->[2] == -1 && !$cgi->param('show_minus1')); # RAE don't show -1 variants if checked
778 :     if ((@$tab1 > 0) && ((@$tab1 % 10) == 0))
779 :     {
780 :     push(@$tab1,[map { "<b>$_</b>" } @$col_hdrs]) ;
781 :     }
782 :     push(@$tab1,$row);
783 :     }
784 :    
785 : overbeek 1.14 my %options=(excelfile=>$ssa, no_excel_link=>1);
786 : parrello 1.18 $to->add(rows => &HTML::make_table($col_hdrs,$tab1,"Basic Spreadsheet", %options) .
787 :     $cgi->hr ."\n");
788 : overbeek 1.1
789 : overbeek 1.27 }
790 :     return [map { [$_,$pegs_for_selected_role->{$_}] }
791 :     keys(%$pegs_for_selected_role)
792 :     ];
793 : overbeek 1.1 }
794 :    
795 :     sub ext_url {
796 :     my($fig,$cgi,$peg) = @_;
797 :    
798 :     my @tmp;
799 :     my @aliases = $fig->feature_aliases($peg);
800 :     if ((@tmp = grep { $_ =~ /^uni\|/ } @aliases) > 0)
801 :     {
802 : parrello 1.7 @aliases = map { &HTML::uni_link($cgi,$_) } @tmp;
803 : overbeek 1.1 }
804 :     elsif ((@tmp = grep { $_ =~ /^sp\|/ } @aliases) > 0)
805 :     {
806 : parrello 1.7 @aliases = map { &HTML::sp_link($cgi,$_) } @tmp;
807 : overbeek 1.1 }
808 :     elsif ((@tmp = grep { $_ =~ /^gi\|/ } @aliases) > 0)
809 :     {
810 : parrello 1.7 @aliases = map { &HTML::gi_link($cgi,$_) } @tmp;
811 : overbeek 1.1 }
812 :     elsif ((@tmp = grep { $_ =~ /^kegg\|/ } @aliases) > 0)
813 :     {
814 : parrello 1.7 @aliases = map { &HTML::kegg_link($cgi,$_) } @tmp;
815 : overbeek 1.1 }
816 :     else
817 :     {
818 : parrello 1.7 return wantarray() ? (&HTML::fid_link($cgi,$peg)) : &HTML::fid_link($cgi,$peg);
819 : overbeek 1.1 }
820 :    
821 :     if (wantarray())
822 :     {
823 : parrello 1.7 return @aliases;
824 : overbeek 1.1 }
825 :     else
826 :     {
827 : parrello 1.7 return $aliases[0];
828 : overbeek 1.1 }
829 :     }
830 :    
831 : overbeek 1.2 sub ext_genus_species {
832 :     my($fig,$genome) = @_;
833 :    
834 :     my $gs = $fig->genus_species($genome);
835 :     my $c = substr($fig->taxonomy_of($genome),0,1);
836 :     return "$gs [$c]";
837 :     }
838 : overbeek 1.27
839 :     sub peg_to_fasta {
840 :     my($fig,$peg,$problems) = @_;
841 :    
842 :     my $func = $fig->function_of($peg);
843 :     my $gs = $fig->genus_species(&FIG::genome_of($peg));
844 :     my $seq = $fig->get_translation($peg);
845 :     $seq =~ s/(.{1,60})/$1\n/g;
846 :     return ">$peg $func [$gs] $problems\n$seq";
847 :     }
848 :    
849 :     sub downloaded_fasta {
850 :     my($fig,$cgi,$pegs_to_download) = @_;
851 :    
852 :     my(%by_func,$tuple,$peg,$num_in_cell,$func);
853 :     my @fasta_download = ();
854 :     foreach $tuple (@$pegs_to_download)
855 :     {
856 :     ($peg,$num_in_cell) = @$tuple;
857 :     $func = $fig->function_of($peg);
858 :     push(@{$by_func{$func}},[$peg,$num_in_cell,$fig->get_translation($peg),$fig->possibly_truncated($peg)]);
859 :     }
860 :     foreach $func (sort keys(%by_func))
861 :     {
862 :     my @to_download = sort { length($a->[2]) <=> length($b->[2]) } @{$by_func{$func}};
863 :     my $median_length = length($to_download[int(@to_download/2)]->[2]);
864 :     foreach my $tuple (@to_download)
865 :     {
866 :     my($peg,$num_in_cell,$pseq,$truncated) = @$tuple;
867 :     my $bad_len = (abs(length($pseq) - $median_length) > (0.2 * $median_length)) ? 1 : 0;
868 :     my @problems = ();
869 :     if ($cgi->param('mark_questionable'))
870 :     {
871 :     if ($truncated) { push(@problems,"possibly truncated") }
872 :     if ($num_in_cell > 1) { push(@problems,"multiple PEGs with functional role") }
873 :     if ($bad_len) { push(@problems,"unusual length") }
874 :     }
875 :     my $fasta = &peg_to_fasta($fig,$peg,(@problems > 0) ? "[" . join(",",@problems) . "]" : "");
876 :     push(@fasta_download,"$fasta\n");
877 :     }
878 :     }
879 :     return join("",(@fasta_download,"</pre><br><br>\n"));
880 :     }
881 :    
882 :     use representative_sequences;
883 :    
884 :     sub take_representative_genomes {
885 :     my($fig,$subsystem,$genomes,$role,$num_reps) = @_;
886 :     my($genome);
887 :    
888 :     if ($num_reps < 1) { return @$genomes }
889 :     my @seqs = ();
890 :     foreach $genome (@$genomes)
891 :     {
892 :     my @pegs_in_cell = $subsystem->get_pegs_from_cell($genome,$role);
893 :     if (@pegs_in_cell > 0)
894 :     {
895 :     push(@seqs,[$pegs_in_cell[0],"",$fig->get_translation($pegs_in_cell[0])]);
896 :     }
897 :     }
898 :    
899 :     if (@seqs <= $num_reps)
900 :     {
901 :     return @$genomes;
902 :     }
903 :     my $parms = { seqs => \@seqs, max_iden => 0.99, max_rep => $num_reps };
904 :     my($reps,undef) = &representative_sequences::n_rep_seqs($parms);
905 :     return map { &FIG::genome_of($_->[0]) } @$reps;
906 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3