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

Annotation of /FigWebServices/protein.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.58 - (view) (download)

1 : overbeek 1.53
2 : efrank 1.1 use FIG;
3 : olson 1.56
4 :     my $sproutAvail = eval {
5 :     require SproutFIG;
6 :     require PageBuilder;
7 :     };
8 :    
9 :     if (!$sproutAvail)
10 :     {
11 :     warn "Sprout library not available: $@\n";
12 :     }
13 :     else
14 :     {
15 :     warn "Sprout libs found\n";
16 :     }
17 :    
18 : heiko 1.45 use FIGGenDB;
19 : olson 1.48 use FIGjs;
20 : efrank 1.1
21 :     use HTML;
22 : olson 1.48 use Data::Dumper;
23 :    
24 : efrank 1.1 use strict;
25 :     use GenoGraphics;
26 :     use CGI;
27 :     my $cgi = new CGI;
28 :    
29 : olson 1.57 use Carp 'cluck';
30 :    
31 : efrank 1.1 if (0)
32 :     {
33 : overbeek 1.40 my $VAR1;
34 :     eval(join("",`cat /tmp/protein_parms`));
35 :     $cgi = $VAR1;
36 :     # print STDERR &Dumper($cgi);
37 :     }
38 :    
39 :     if (0)
40 :     {
41 : efrank 1.1 print $cgi->header;
42 :     my @params = $cgi->param;
43 :     print "<pre>\n";
44 :     foreach $_ (@params)
45 :     {
46 :     print "$_\t:",join(",",$cgi->param($_)),":\n";
47 :     }
48 : overbeek 1.40
49 :     if (0)
50 :     {
51 :     if (open(TMP,">/tmp/protein_parms"))
52 :     {
53 :     print TMP &Dumper($cgi);
54 :     close(TMP);
55 :     }
56 :     }
57 : efrank 1.1 exit;
58 :     }
59 :    
60 : overbeek 1.53 my($fig_or_sprout);
61 :     if ($cgi->param('SPROUT'))
62 :     {
63 : olson 1.56 $fig_or_sprout = new SproutFIG($FIG_Config::sproutDB, $FIG_Config::sproutData);
64 : overbeek 1.53 }
65 :     else
66 :     {
67 :     $fig_or_sprout = new FIG;
68 :     }
69 :    
70 : efrank 1.1 my $html = [];
71 : overbeek 1.53
72 : golsen 1.19 unshift @$html, "<TITLE>The SEED Protein Page</TITLE>\n";
73 : efrank 1.1
74 :     my $prot = $cgi->param('prot');
75 :     if (! $prot)
76 :     {
77 : golsen 1.19 unshift @$html, "<TITLE>The SEED: Protein Page</TITLE>\n";
78 : efrank 1.1 push(@$html,"<h1>Sorry, you need to specify a protein</h1>\n");
79 : overbeek 1.53 &display_page($fig_or_sprout,$cgi,$html);
80 : efrank 1.1 exit;
81 :     }
82 : golsen 1.34
83 :     if ($prot !~ /^fig\|/)
84 : overbeek 1.16 {
85 : overbeek 1.53 my @poss = &by_alias($fig_or_sprout,$prot);
86 :    
87 : overbeek 1.44 if (@poss > 0)
88 : overbeek 1.16 {
89 : overbeek 1.44 $prot = $poss[0];
90 : overbeek 1.16 }
91 :     else
92 :     {
93 : golsen 1.19 unshift @$html, "<TITLE>The SEED: Protein Page</TITLE>\n";
94 : overbeek 1.16 push(@$html,"<h1>Sorry, $prot appears not to have a FIG id at this point</h1>\n");
95 : overbeek 1.53 &display_page($fig_or_sprout,$cgi,$html);
96 : overbeek 1.16 exit;
97 :     }
98 :     }
99 : efrank 1.1
100 : overbeek 1.53
101 : golsen 1.34 #
102 :     # Allow previous and next actions in calls to the script -- GJO
103 :     #
104 :    
105 :     my $adjust = $cgi->param('previous PEG') ? -1 : $cgi->param('next PEG') ? 1 : 0;
106 :     if ( $adjust ) {
107 :     my ( $prefix, $protnum ) = $prot =~ /^(.*\.)(\d+)$/;
108 :     if ( $prefix && $protnum ) {
109 :     my $prot2 = $prefix . ($protnum + $adjust);
110 : overbeek 1.53 if ( &translatable($fig_or_sprout, $prot2 ) ) {
111 : golsen 1.34 $prot = $prot2;
112 :     $cgi->delete('prot');
113 :     $cgi->param(-name => 'prot', -value => $prot);
114 :     }
115 :     }
116 :     ( $adjust < 0 ) && $cgi->delete('previous PEG');
117 :     ( $adjust > 0 ) && $cgi->delete('next PEG');
118 :     }
119 :    
120 :     my $request = $cgi->param("request") || "";
121 :    
122 : olson 1.58 my $compute_ok = eval {
123 :    
124 :    
125 : overbeek 1.53 if ($request eq "use_protein_tool") { &use_protein_tool($fig_or_sprout,$cgi,$html,$prot); }
126 :     elsif ($request eq "view_annotations") { &view_annotations($fig_or_sprout,$cgi,$html,$prot); }
127 :     elsif ($request eq "view_all_annotations") { &view_all_annotations($fig_or_sprout,$cgi,$html,$prot); }
128 :     elsif ($request eq "aa_sequence") { &aa_sequence($fig_or_sprout,$cgi,$html,$prot); }
129 :     elsif ($request eq "dna_sequence") { &dna_sequence($fig_or_sprout,$cgi,$html,$prot); }
130 :     elsif ($request eq "fast_assign") { $html = &make_assignment($fig_or_sprout,$cgi,$html,$prot); }
131 :     elsif ($request eq "show_coupling_evidence") { &show_coupling_evidence($fig_or_sprout,$cgi,$html,$prot); }
132 :     elsif ($request eq "ec_to_maps") { &show_ec_to_maps($fig_or_sprout,$cgi,$html); }
133 :     elsif ($request eq "link_to_map") { &link_to_map($fig_or_sprout,$cgi,$html); }
134 :     elsif ($request eq "fusions") { &show_fusions($fig_or_sprout,$cgi,$html,$prot); }
135 :     else
136 :     {
137 :     $html = &show_html_followed_by_initial($fig_or_sprout,$cgi,$html,$prot);
138 :     }
139 : olson 1.58 };
140 :    
141 :     if (!$compute_ok)
142 :     {
143 :     print "Content-type: text/html\n";
144 :     print "\n";
145 : efrank 1.1
146 : olson 1.58 print "Error encountered during page computation:\n";
147 :     print "<pre>\n$@\n</pre>\n";
148 :     exit;
149 :    
150 :     }
151 : overbeek 1.53 &display_page($fig_or_sprout,$cgi,$html);
152 : overbeek 1.11 exit;
153 :    
154 :     #==============================================================================
155 :     # use_protein_tool
156 :     #==============================================================================
157 : efrank 1.1
158 :     sub use_protein_tool {
159 : overbeek 1.53 my($fig_or_sprout,$cgi,$html,$prot) = @_;
160 : efrank 1.1 my($url,$method,@args,$line,$name,$val);
161 :    
162 : overbeek 1.53 my $seq = &get_translation($fig_or_sprout,$prot);
163 : efrank 1.1 if (! $seq)
164 :     {
165 : golsen 1.19 unshift @$html, "<TITLE>The SEED: Protein Page</TITLE>\n";
166 : efrank 1.1 push(@$html,$cgi->h1("Sorry, $prot does not have a translation"));
167 :     return;
168 :     }
169 :     my $protQ = quotemeta $prot;
170 :    
171 :     my $tool = $cgi->param('tool');
172 :     $/ = "\n//\n";
173 :     my @tools = grep { $_ =~ /^$tool\n/ } `cat $FIG_Config::global/LinksToTools`;
174 :     if (@tools == 1)
175 :     {
176 :     chomp $tools[0];
177 :     (undef,undef,$url,$method,@args) = split(/\n/,$tools[0]);
178 :     my $args = [];
179 :     foreach $line (@args)
180 :     {
181 :     ($name,$val) = split(/\t/,$line);
182 :     $val =~ s/FIGID/$prot/;
183 :     $val =~ s/FIGSEQ/$seq/;
184 :     $val =~ s/\\n/\n/g;
185 :     push(@$args,[$name,$val]);
186 :     }
187 : golsen 1.19 unshift @$html, "<TITLE>The SEED: Protein Tool</TITLE>\n";
188 : efrank 1.1 push(@$html,&HTML::get_html($url,$method,$args));
189 :     }
190 :     }
191 :    
192 : overbeek 1.11 #==============================================================================
193 :     # make_assignment
194 :     #==============================================================================
195 :    
196 : efrank 1.1 sub make_assignment {
197 : overbeek 1.53 my($fig_or_sprout,$cgi,$html,$prot) = @_;
198 : efrank 1.1 my($userR);
199 :    
200 :     my $function = $cgi->param('func');
201 :     my $user = $cgi->param('user');
202 :    
203 :     if ($function && $user && $prot)
204 :     {
205 :     if ($user =~ /master:(.*)/)
206 :     {
207 :     $userR = $1;
208 : overbeek 1.53 &assign_function($fig_or_sprout,$prot,"master",$function,"");
209 :     &add_annotation($fig_or_sprout,$prot,$userR,"Set master function to\n$function\n");
210 : efrank 1.1 }
211 :     else
212 :     {
213 : overbeek 1.53 &assign_function($fig_or_sprout,$prot,$user,$function,"");
214 :     &add_annotation($fig_or_sprout,$prot,$user,"Set function to\n$function\n");
215 : efrank 1.1 }
216 :     }
217 :     $cgi->delete("request");
218 :     $cgi->delete("func");
219 : overbeek 1.53 $html = &show_html_followed_by_initial($fig_or_sprout,$cgi,$html,$prot);
220 :     return $html;
221 : efrank 1.1 }
222 :    
223 : overbeek 1.11 #==============================================================================
224 :     # view_annotations
225 :     #==============================================================================
226 :    
227 : efrank 1.1 sub view_annotations {
228 : overbeek 1.53 my($fig_or_sprout,$cgi,$html,$prot) = @_;
229 : efrank 1.1
230 : golsen 1.19 unshift @$html, "<TITLE>The SEED: Protein Annotations</TITLE>\n";
231 : efrank 1.1 my $col_hdrs = ["who","when","annotation"];
232 : overbeek 1.53 my $tab = [ map { [$_->[2],$_->[1],"<pre>" . $_->[3] . "<\/pre>"] } &feature_annotations($fig_or_sprout,$prot) ];
233 : efrank 1.1 if (@$tab > 0)
234 :     {
235 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"Annotations for $prot"));
236 :     }
237 :     else
238 :     {
239 :     push(@$html,"<h1>No Annotations for $prot</h1>\n");
240 :     }
241 :     }
242 :    
243 : overbeek 1.15 sub view_all_annotations {
244 : overbeek 1.53 my($fig_or_sprout,$cgi,$html,$peg) = @_;
245 : overbeek 1.15 my($ann);
246 :    
247 : golsen 1.19 unshift @$html, "<TITLE>The SEED: Protein Annotations</TITLE>\n";
248 : overbeek 1.53 if (&is_real_feature($fig_or_sprout,$peg))
249 : overbeek 1.15 {
250 :     my $col_hdrs = ["who","when","PEG","genome","annotation"];
251 : overbeek 1.53 my @related = &related_by_func_sim($fig_or_sprout,$peg,$cgi->param('user'));
252 : overbeek 1.15 push(@related,$peg);
253 :    
254 : overbeek 1.53 my @annotations = &merged_related_annotations($fig_or_sprout,\@related);
255 : overbeek 1.15
256 :     my $tab = [ map { $ann = $_;
257 :     [$ann->[2],$ann->[1],&HTML::fid_link($cgi,$ann->[0]),
258 : overbeek 1.53 &genus_species($fig_or_sprout,&genome_of($ann->[0])),
259 : overbeek 1.15 "<pre>" . $ann->[3] . "</pre>"
260 :     ] } @annotations];
261 :     if (@$tab > 0)
262 :     {
263 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"All Related Annotations for $peg"));
264 :     }
265 :     else
266 :     {
267 :     push(@$html,"<h1>No Annotations for $peg</h1>\n");
268 :     }
269 :     }
270 :     }
271 :    
272 : overbeek 1.11 #==============================================================================
273 :     # show_coupling_evidence
274 :     #==============================================================================
275 :    
276 : efrank 1.1 sub show_coupling_evidence {
277 : overbeek 1.53 my($fig_or_sprout,$cgi,$html,$peg) = @_;
278 : efrank 1.1 my($pair,$peg1,$peg2,$link1,$link2);
279 :    
280 : golsen 1.19 unshift @$html, "<TITLE>The SEED: Functional Coupling</TITLE>\n";
281 : efrank 1.1 my $user = $cgi->param('user');
282 :     my $to = $cgi->param('to');
283 : overbeek 1.53 my @coup = grep { $_->[1] eq $to } &coupling_and_evidence($fig_or_sprout,$peg,5000,1.0e-10,4);
284 : efrank 1.1
285 :     if (@coup != 1)
286 :     {
287 :     push(@$html,"<h1>Sorry, no evidence that $peg is coupled to $to</h1>\n");
288 :     }
289 :     else
290 :     {
291 :     my $col_hdrs = ["Peg1","Organism1","Function1","Peg2","Organism2","Function2"];
292 :     my $tab = [];
293 :     foreach $pair (@{$coup[0]->[2]})
294 :     {
295 :     ($peg1,$peg2) = @$pair;
296 :     $link1 = &HTML::fid_link($cgi,$peg1);
297 :     $link2 = &HTML::fid_link($cgi,$peg2);
298 : overbeek 1.11 push( @$tab, [ $link1,
299 : overbeek 1.53 &org_of($fig_or_sprout,$peg1),
300 :     scalar &function_ofS($fig_or_sprout,$peg1,$user),
301 : overbeek 1.11 $link2,
302 : overbeek 1.53 &org_of($fig_or_sprout,$peg2),
303 :     scalar &function_ofS($fig_or_sprout,$peg2,$user)
304 : overbeek 1.11 ]
305 :     );
306 : efrank 1.1 }
307 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"Evidence that $peg Is Coupled To $to"));
308 :     }
309 :     }
310 :    
311 : overbeek 1.11 #==============================================================================
312 :     # psi_blast_prot_sequence
313 :     #==============================================================================
314 :    
315 : efrank 1.1 sub psi_blast_prot_sequence {
316 : overbeek 1.53 my($fig_or_sprout,$cgi,$prot_id) = @_;
317 : efrank 1.1 }
318 :    
319 : overbeek 1.11 #==============================================================================
320 :     # show_initial
321 :     #==============================================================================
322 :    
323 : efrank 1.1 sub show_initial {
324 : overbeek 1.53 my($fig_or_sprout,$cgi,$html,$prot) = @_;
325 :    
326 :     unshift @{$html->{general}}, "<TITLE>The SEED: Protein Page</TITLE>\n";
327 : efrank 1.1
328 : overbeek 1.53 my $gs = &org_of($fig_or_sprout,$prot);
329 : olson 1.56 warn "got gs=$gs prot=$prot $fig_or_sprout\n";
330 : efrank 1.1 if ($prot =~ /^fig\|\d+\.\d+\.peg/)
331 :     {
332 : overbeek 1.53 if (! &is_real_feature($fig_or_sprout,$prot))
333 : overbeek 1.36 {
334 : overbeek 1.53 push(@{$html->{general}},"<h1>Sorry, $prot is an unknown identifier</h1>\n");
335 : overbeek 1.11 }
336 :     else
337 :     {
338 : overbeek 1.53 push(@{$html->{general}},"<h1>Protein $prot: $gs</h1>\n");
339 :     &translation_piece($fig_or_sprout,$cgi,$html->{translate_status});
340 :     &display_peg($fig_or_sprout,$cgi,$html,$prot);
341 : overbeek 1.11 }
342 : efrank 1.1 }
343 :     else
344 :     {
345 : overbeek 1.53 # &display_external($fig_or_sprout,$cgi,$html,$prot);
346 : efrank 1.1 }
347 :     }
348 :    
349 : overbeek 1.11 #==============================================================================
350 :     # display_peg
351 :     #==============================================================================
352 :    
353 : efrank 1.1 sub display_peg {
354 : overbeek 1.53 my($fig_or_sprout,$cgi,$html,$peg) = @_;
355 : efrank 1.1 my $loc;
356 :    
357 : overbeek 1.53 my $user = $cgi->param('user');
358 :    
359 : efrank 1.1 my $half_sz = 5000;
360 : overbeek 1.10 my $fc = $cgi->param('fc');
361 :     my @fc_data;
362 :     if ($fc)
363 :     {
364 : redwards 1.49 # RAE Added the following lines so that you can define this in the URL
365 :     # but the default behavior remains unchanged. I doubt anyone will ever
366 :     # see this, but I use it sometimes to see what happens
367 :    
368 :     my ($bound,$sim_cutoff,$coupling_cutoff)=(5000, 1.0e-10, 4);
369 :     if ($cgi->param('fcbound')) {$bound=$cgi->param('fcbound')}
370 :     if ($cgi->param('fcsim')) {$sim_cutoff=$cgi->param('fcsim')}
371 :     if ($cgi->param('fccoup')) {$coupling_cutoff=$cgi->param('fccoup')}
372 :    
373 : overbeek 1.53 @fc_data = &coupling_and_evidence($fig_or_sprout,$peg,$bound,$sim_cutoff,$coupling_cutoff);
374 : overbeek 1.10 }
375 :     else
376 :     {
377 :     @fc_data = ();
378 :     }
379 : efrank 1.1
380 : overbeek 1.53 if ($loc = &feature_locationS($fig_or_sprout,$peg))
381 : efrank 1.1 {
382 : overbeek 1.53 my($contig,$beg,$end) = &boundaries_of($fig_or_sprout,$loc);
383 :     my $min = &max(0,&min($beg,$end) - $half_sz);
384 :     my $max = &max($beg,$end) + $half_sz;
385 : olson 1.56 warn "display_peg: min=$min max=$max beg=$beg end=$end\n";
386 : overbeek 1.53 my($feat,$min,$max) = &genes_in_region($fig_or_sprout,&genome_of($peg),$contig,$min,$max);
387 : efrank 1.1
388 : overbeek 1.53 my ($beg,$end,$genes) = &print_context($fig_or_sprout,$cgi,$html->{contig_context},$peg,$feat,$min,$max);
389 :     &print_graphics_context($beg,$end,$genes,$html->{context_graphic});
390 : overbeek 1.2 }
391 :    
392 : overbeek 1.53 &print_assignments($fig_or_sprout,$cgi,$html->{assgn_for_equiv_prots},$peg);
393 :     &print_kv_pairs($fig_or_sprout,$cgi,$html->{kv_pairs},$peg);
394 :     &print_subsys_connections($fig_or_sprout,$cgi,$html->{subsys_connections},$peg,$user);
395 :     &print_links($fig_or_sprout,$cgi,$html->{links},$peg);
396 : overbeek 1.44
397 : overbeek 1.53 push @{$html->{javascript}}, "\n", &FIGjs::toolTipScript();
398 : golsen 1.18
399 : overbeek 1.53 my $has_translation = &translatable($fig_or_sprout,$peg);
400 :     &print_services($fig_or_sprout,$cgi,$html->{services},$peg,$has_translation,\@fc_data);
401 :     &print_sims_block($fig_or_sprout,$cgi,$html->{similarities},$peg,$user,$has_translation);
402 : efrank 1.1
403 :     if ($has_translation)
404 :     {
405 : overbeek 1.53 &show_tools($fig_or_sprout,$cgi,$html->{tools},$peg);
406 : efrank 1.1 }
407 :     }
408 :    
409 :     ################# Table-Driven Show Tools ############################
410 :    
411 :     sub show_tools {
412 : overbeek 1.53 my($fig_or_sprout,$cgi,$html,$peg) = @_;
413 : efrank 1.1
414 :     $cgi->param(-name => "request",
415 :     -value => "use_protein_tool");
416 :     my $url = $cgi->self_url();
417 :    
418 :     if (open(TMP,"<$FIG_Config::global/LinksToTools"))
419 :     {
420 :     my $col_hdrs = ["Tool","Description"];
421 :     my $tab = [];
422 :    
423 :     $/ = "\n//\n";
424 :     while (defined($_ = <TMP>))
425 :     {
426 :     my($tool,$desc) = split(/\n/,$_);
427 :     push(@$tab,["<a href=\"$url\&tool=$tool\">$tool</a>",$desc]);
428 :     }
429 :     close(TMP);
430 :     $/ = "\n";
431 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"Tools to Analyze Protein Sequences"));
432 :     }
433 :     $cgi->delete('request');
434 :     }
435 :    
436 :     ################# Functional Coupling ############################
437 :    
438 :     sub print_fc {
439 : overbeek 1.53 my($fig_or_sprout,$cgi,$html,$peg,$fc_data) = @_;
440 : efrank 1.1 my($sc,$neigh);
441 :    
442 :     my $user = $cgi->param('user');
443 :     my @tab = map { ($sc,$neigh) = @$_;
444 : overbeek 1.53 [&ev_link($cgi,$neigh,$sc),$neigh,scalar &function_ofS($fig_or_sprout,$neigh,$user)]
445 : efrank 1.1 }
446 : overbeek 1.10 @$fc_data;
447 : efrank 1.1 if (@tab > 0)
448 :     {
449 :     push(@$html,"<hr>\n");
450 :     my $col_hdrs = ["Score","Peg","Function"];
451 :     push(@$html,&HTML::make_table($col_hdrs,\@tab,"Functional Coupling"));
452 :     }
453 :     }
454 :    
455 :     sub ev_link {
456 :     my($cgi,$neigh,$sc) = @_;
457 :    
458 :     my $prot = $cgi->param('prot');
459 :     my $link = $cgi->url() . "?request=show_coupling_evidence&prot=$prot&to=$neigh";
460 :     return "<a href=$link>$sc</a>";
461 :     }
462 :    
463 :     ################# Assignments ############################
464 :    
465 :     sub trans_function_of {
466 : overbeek 1.53 my($cgi,$fig_or_sprout,$peg,$user) = @_;
467 : efrank 1.1
468 :     if (wantarray())
469 :     {
470 :     my $x;
471 : overbeek 1.53 my @funcs = &function_ofL($fig_or_sprout,$peg);
472 : efrank 1.1 if ($cgi->param('translate'))
473 :     {
474 : overbeek 1.53 @funcs = map { $x = $_; $x->[1] = &translate_function($fig_or_sprout,$x->[1]); $x } @funcs;
475 : efrank 1.1 }
476 :     return @funcs;
477 :     }
478 :     else
479 :     {
480 : overbeek 1.53 my $func = &function_ofS($fig_or_sprout,$peg,$user);
481 : efrank 1.1 if ($cgi->param('translate'))
482 :     {
483 : overbeek 1.53 $func = &translate_function($fig_or_sprout,$func);
484 : efrank 1.1 }
485 :     return $func;
486 :     }
487 :     }
488 :    
489 : overbeek 1.53 ########################## Routines that build pieces of HTML ######################
490 :    
491 :    
492 :     sub print_sims_block {
493 :     my($fig_or_sprout,$cgi,$html,$peg,$user,$has_translation) = @_;
494 :    
495 :     my $sims = $cgi->param('sims');
496 :     if ((! $sims) && $has_translation)
497 :     {
498 :     my $max_expand = $cgi->param('max_expand') || 5;
499 :     my $maxN = $cgi->param('maxN') || 50; # Default 50, not 5 (GJO)
500 :     my $maxP = $cgi->param('maxP') || 1.0e-5;
501 :     my $ex_raw = $cgi->param('expand_raw') || 0; # Default 0, not 1 (GJO)
502 :     my $just_fig = $cgi->param('just_fig') || 0;
503 :     my $show_env = $cgi->param('show_env') || 0;
504 :     my $hide_alias = $cgi->param('hide_alias') || 0;
505 :    
506 :     push( @$html, $cgi->start_form(-action => "protein.cgi#Similarities"));
507 :     if ($cgi->param('translate'))
508 :     {
509 :     push(@$html,$cgi->hidden(-name => 'translate', -value => 1));
510 :     }
511 :     my $sprout = $cgi->param('SPROUT') ? 1 : "";
512 :    
513 :     push( @$html, $cgi->hidden(-name => 'prot', -value => $peg),
514 :     $cgi->hidden(-name => 'sims', -value => 1),
515 :     $cgi->hidden(-name => 'fid', -value => $peg),
516 :     $cgi->hidden(-name => 'user', -value => $user),
517 :     $cgi->hidden(-name => 'SPROUT', -value => $sprout),
518 :     $cgi->submit('Similarities'),
519 :     " MaxN: ", $cgi->textfield(-name => 'maxN', -size => 5, -value => $maxN, -override => 1),
520 :     " Max expand: ", $cgi->textfield(-name => 'max_expand', -size => 5, -value => $max_expand, -override => 1),
521 :     " MaxP: ", $cgi->textfield(-name => 'maxP', -size => 10, -value => $maxP),
522 :     " Just FIG Ids: ", $cgi->checkbox(-name => 'just_fig', -value => 1, -checked => $just_fig, -override => 1, -label => ""),
523 :     " Show Env. samples: ", $cgi->checkbox(-name => 'show_env', -value => 1, -checked => $show_env, -override => 1, -label => ""),
524 :     " Hide aliases: ", $cgi->checkbox(-name => 'hide_alias', -value => 1, -checked => $hide_alias, -override => 1, -label => ""),
525 :     $cgi->end_form
526 :     );
527 :     }
528 :     elsif ($sims)
529 :     {
530 :     &print_similarities($fig_or_sprout,$cgi,$html,$peg);
531 :     }
532 :     }
533 :    
534 :    
535 :     sub print_services {
536 :     my($fig_or_sprout,$cgi,$html,$peg,$has_translation,$fc_data) = @_;
537 :    
538 :     my $link1 = $cgi->self_url() . "&request=view_annotations";
539 :     my $link2 = $cgi->self_url() . "&request=view_all_annotations";
540 :     push(@$html,"<br><a href=$link1>To View Annotations</a>/<a href=$link2>To View All Related Annotations</a>\n");
541 :    
542 :     push(@$html, "<br/>".&FIGGenDB::linkPEGGenDB($peg));
543 :     push(@$html, "<br/>".&FIGGenDB::importOrganismGenDB($peg));
544 :    
545 :     my $link = $cgi->self_url() . "&request=aa_sequence";
546 :     push(@$html,"<br><a href=$link>Protein Sequence</a>\n");
547 :    
548 :     $link = $cgi->self_url() . "&request=dna_sequence";
549 :     push(@$html,"<br><a href=$link>DNA Sequence</a>\n");
550 :    
551 :     $link = $cgi->url();
552 :     $link =~ s/protein.cgi/fid_checked.cgi/;
553 :     my $sprout = $cgi->param('SPROUT') ? 1 : "";
554 :     my $user = $cgi->param('user');
555 :     if (! $user)
556 :     {
557 :     $user = "";
558 :     }
559 :     else
560 :     {
561 :     $link = $link . "?SPROUT=$sprout&fid=$prot&user=$user&checked=$prot&assign/annotate=assign/annotate";
562 :     push(@$html,"<br><a href=$link target=checked_window>To Make an Annotation</a>\n");
563 :     }
564 :    
565 :     my $fc = $cgi->param('fc');
566 :     if ((! $fc) && (&feature_locationS($fig_or_sprout,$peg)))
567 :     {
568 :     my $link = $cgi->self_url() . "&fc=1";
569 :     push(@$html,"<br><a href=$link>To Get Detailed Functional Coupling Data</a>\n");
570 :     }
571 :     elsif ($fc)
572 :     {
573 :     &print_fc($fig_or_sprout,$cgi,$html,$peg,$fc_data);
574 :     }
575 :    
576 :     my $link = $cgi->self_url() . "&request=fusions";
577 :     push(@$html,"<br><a href=$link>To Get Fusion Data</a>\n");
578 :    
579 :     my $sprout = $cgi->param('SPROUT') ? 1 : "";
580 :     my $link = &cgi_url . "/homologs_in_clusters.cgi?SPROUT=$sprout&prot=$peg&user=$user\n";
581 :     push(@$html,"<br><a href=$link>To Find Homologs in Clusters</a>\n");
582 :    
583 :     if ((! $cgi->param('compare_region')) && $has_translation)
584 :     {
585 :     my $link = $cgi->self_url() . "&compare_region=1";
586 :     push(@$html,"<br><a href=$link>To Compare Region</a>\n");
587 :     }
588 :     elsif ($cgi->param('compare_region'))
589 :     {
590 :     &print_compared_regions($fig_or_sprout,$cgi,$html,$peg);
591 :     }
592 :     }
593 :    
594 : efrank 1.1 sub print_assignments {
595 : overbeek 1.53 my($fig_or_sprout,$cgi,$html,$peg) = @_;
596 : efrank 1.1 my($who,$func,$ec,@ecs,@tmp,$id,$i,$master_func,$user_func,$x);
597 :    
598 :     my $user = $cgi->param('user');
599 : overbeek 1.53 my @funcs = map { [$peg,@$_] } &trans_function_of($cgi,$fig_or_sprout,$peg);
600 : efrank 1.1
601 :     for ($i=0; ($i < @funcs) && ($funcs[$i]->[1] ne "master"); $i++) {}
602 :     if ($i < @funcs)
603 :     {
604 :     $master_func = $funcs[$i]->[2];
605 :     }
606 :     else
607 :     {
608 :     $master_func = "";
609 :     }
610 :    
611 :     for ($i=0; ($i < @funcs) && ($funcs[$i]->[1] ne $user); $i++) {}
612 :     if ($i < @funcs)
613 :     {
614 :     $user_func = $funcs[$i]->[2];
615 :     }
616 :     else
617 :     {
618 :     $user_func = $master_func;
619 :     }
620 :     push(@$html,$cgi->h2("Current Assignment: $peg: $user_func"));
621 : overbeek 1.53 my @maps_to = grep { $_ ne $peg } map { $_->[0] } &mapped_prot_ids($fig_or_sprout,$peg);
622 : efrank 1.1 @funcs = ();
623 :     foreach $id (@maps_to)
624 :     {
625 : overbeek 1.53 if (($id ne $peg) && (@tmp = &trans_function_of($cgi,$fig_or_sprout,$id)) && (@tmp > 0))
626 : efrank 1.1 {
627 :     push(@funcs, map { $x = $_; [$id,@$_] } @tmp);
628 :     }
629 :     }
630 :     @funcs = map { ($_->[1] eq "master") ? [$_->[0],"",$_->[2]] : $_ } @funcs;
631 :     push(@$html,"<hr>\n");
632 :    
633 :     if ((@funcs == 0) && (! $user_func))
634 :     {
635 :     push(@$html,$cgi->h1("No function has been assigned"));
636 :     }
637 : overbeek 1.25
638 : overbeek 1.53 my $tab = [ map { ($id,$who,$func) = @$_; [ &HTML::set_prot_links($cgi,$id),&org_of($fig_or_sprout,$id),$who,($user ? &assign_link($cgi,$func,$user_func) : ""), &set_map_links($fig_or_sprout,&genome_of($peg),$func)] } @funcs ];
639 : overbeek 1.25 if (@$tab > 0)
640 : efrank 1.1 {
641 :     my $col_hdrs = ["Id","Organism","Who","ASSIGN","Assignment"];
642 :     my $title = "Assignments for Essentially Identical Proteins";
643 :     push(@$html,&HTML::make_table($col_hdrs,$tab,$title));
644 :     }
645 : overbeek 1.53 }
646 :    
647 :     sub print_kv_pairs {
648 :     my($fig_or_sprout,$cgi,$html,$peg) = @_;
649 : efrank 1.1
650 : overbeek 1.53 my @attr = &feature_attributes($fig_or_sprout,$peg);
651 : overbeek 1.38 if (@attr > 0)
652 :     {
653 :     my $tab = [];
654 :     foreach $_ (@attr)
655 :     {
656 :     my($tag,$val,$url) = @$_;
657 :     push(@$tab,[$tag,"<a href=\"$url\">$val</a>"]);
658 :     }
659 :     push(@$html,$cgi->br,$cgi->hr,&HTML::make_table(["Key","Value"],$tab,"Attributes"),$cgi->hr);
660 :     }
661 : overbeek 1.53 }
662 :    
663 :     sub print_subsys_connections {
664 :     my($fig_or_sprout,$cgi,$html,$peg,$user) = @_;
665 : overbeek 1.38
666 : olson 1.28 #
667 :     # Show the subsystems in which this protein participates.
668 :     #
669 :    
670 : overbeek 1.53 if (my @subsystems = &subsystems_for_peg($fig_or_sprout,$peg))
671 : olson 1.28 {
672 :     push(@$html,
673 :     $cgi->h2("Subsystems in which this peg is present"));
674 :    
675 :     my(@hdrs);
676 :     my(@table);
677 :    
678 :     @hdrs = ("Subsystem", "Role");
679 :    
680 : overbeek 1.53 my $sprout = $cgi->param('SPROUT') ? 1 : "";
681 :    
682 : olson 1.28 for my $ent (@subsystems)
683 :     {
684 :     my($sub, $role) = @$ent;
685 : overbeek 1.53 my $url = $cgi->a({href => "subsys.cgi?SPROUT=$sprout&user=$user&ssa_name=$sub&request=show_ssa"}, $sub);
686 : olson 1.28 push(@table, [$url, $role]);
687 :     }
688 :     push(@$html, &HTML::make_table(\@hdrs, \@table));
689 :     }
690 : overbeek 1.53 }
691 :    
692 :     sub print_links {
693 :     my($fig_or_sprout,$cgi,$html,$peg) = @_;
694 : overbeek 1.31
695 : overbeek 1.53 my @links = &peg_links($fig_or_sprout,$peg)
696 :     ;
697 : overbeek 1.31 if (@links > 0)
698 : overbeek 1.25 {
699 : overbeek 1.31 my $col_hdrs = [1,2,3,4,5];
700 : overbeek 1.25 my $title = "Links to Related Entries in Other Sites";
701 : overbeek 1.31 my $tab = [];
702 :     my ($n,$i);
703 :     for ($i=0; ($i < @links); $i += 5)
704 :     {
705 :     $n = (($i + (5-1)) < @links) ? $i+(5-1) : $i+(@links - $i);
706 :     push(@$tab,[@links[$i..$n]]);
707 :     }
708 : overbeek 1.26 push(@$html,&HTML::make_table($col_hdrs,$tab,$title));
709 : overbeek 1.25 }
710 :    
711 : overbeek 1.53 if (! $cgi->param('SPROUT'))
712 :     {
713 :     my $url = &cgi_url . "/add_links.cgi?peg=$peg";
714 :     push(@$html,"<a href=$url>To Add New Links to this Gene</a>\n");
715 :     }
716 : efrank 1.1 }
717 :    
718 :    
719 :    
720 :     ################# Similarities ############################
721 :    
722 :    
723 :     sub print_similarities {
724 : overbeek 1.53 my( $fig_or_sprout, $cgi, $html, $peg ) = @_;
725 : golsen 1.34 my( $maxN, $maxP, $expand_groups, $ex_checked );
726 : efrank 1.1
727 : golsen 1.18 my $user = $cgi->param('user') || "";
728 : overbeek 1.53 my $current_func = &trans_function_of($cgi,$fig_or_sprout,$peg,$user);
729 : efrank 1.1
730 : golsen 1.18 $maxN = defined( $cgi->param('maxN') ) ? $cgi->param('maxN') : 5;
731 :     $maxP = defined( $cgi->param('maxP') ) ? $cgi->param('maxP') : 1.0e-5;
732 :     $expand_groups = $cgi->param('expand_groups');
733 :     $ex_checked = $expand_groups ? "checked" : "";
734 :    
735 :     my $max_expand = $cgi->param('max_expand') || 0;
736 :     my $just_fig = $cgi->param('just_fig') || 0;
737 : overbeek 1.23 my $show_env = $cgi->param('show_env') || 0;
738 : golsen 1.18 my $hide_alias = $cgi->param('hide_alias') || 0;
739 : efrank 1.1
740 : golsen 1.34 push( @$html, $cgi->hr,
741 :     "<a name=Similarities>",
742 :     $cgi->h1('Similarities'),
743 :     "</a>\n"
744 :     );
745 :    
746 :     #
747 :     # Instead of automatically doubling maxN, use the value of
748 :     # $cgi->param("more similarities") to drive increase in maxN and
749 :     # max_expand
750 :     #
751 :     if ( $cgi->param('more similarities') ) {
752 :     $maxN *= 2;
753 :     $max_expand *= 2;
754 :     $cgi->delete('more similarities');
755 :     }
756 :    
757 :     my ( $prev, $next ) = ( 0, 0 );
758 :     my ( $prefix, $protnum ) = $peg =~ /^(.*\.)(\d+)$/;
759 :     if ( $prefix && $protnum ) {
760 : overbeek 1.53 $prev = ( $protnum > 1 ) && &translatable($fig_or_sprout, $prefix . ($protnum-1) );
761 :     $next = &translatable($fig_or_sprout, $prefix . ($protnum+1) );
762 : golsen 1.34 }
763 : efrank 1.1
764 : overbeek 1.51 push(@$html, $cgi->start_form(-action => "protein.cgi#Similarities"));
765 :    
766 :     if ($cgi->param('translate'))
767 :     {
768 :     push(@$html,$cgi->hidden(-name => 'translate', -value => 1));
769 :     }
770 :    
771 : overbeek 1.53 my $sprout = $cgi->param('SPROUT') ? 1 : "";
772 : overbeek 1.51 push(@$html, $cgi->hidden(-name => 'prot', -value => $peg),
773 : overbeek 1.53 $cgi->hidden(-name => 'SPROUT', -value => $sprout),
774 : efrank 1.1 $cgi->hidden(-name => 'sims', -value => 1),
775 : golsen 1.34 $cgi->hidden(-name => 'fid', -value => $peg),
776 : efrank 1.1 $cgi->hidden(-name => 'user', -value => $user),
777 : golsen 1.34 " MaxN: ", $cgi->textfield(-name => 'maxN', -size => 5, -value => $maxN, -override => 1),
778 : golsen 1.18 " Max expand: ", $cgi->textfield(-name => 'max_expand', -size => 5, -value => $max_expand, -override => 1),
779 :     " MaxP: ", $cgi->textfield(-name => 'maxP', -size => 10, -value => $maxP),
780 :     " Just FIG Ids: ", $cgi->checkbox(-name => 'just_fig', -value => 1, -checked => $just_fig, -override => 1, -label => ""),
781 : overbeek 1.23 " Show Env. samples: ", $cgi->checkbox(-name => 'show_env', -value => 1, -checked => $show_env, -override => 1, -label => ""),
782 : golsen 1.18 " Hide aliases: ", $cgi->checkbox(-name => 'hide_alias', -value => 1, -checked => $hide_alias, -override => 1, -label => ""),
783 : golsen 1.34 $cgi->br,
784 :     $prev ? $cgi->submit('previous PEG') : (),
785 :     $cgi->submit('resubmit'),
786 :     $cgi->submit('more similarities'),
787 :     $next ? $cgi->submit('next PEG') : (),
788 :     $cgi->end_form
789 :     );
790 : efrank 1.1
791 : golsen 1.34 push( @$html, $cgi->hr );
792 : efrank 1.1
793 : golsen 1.18 my $select = $just_fig ? "fig" : "all";
794 : overbeek 1.53 my @sims = &sims($fig_or_sprout, $peg, $maxN, $maxP, $select, $max_expand );
795 : efrank 1.1
796 :     if (@sims)
797 :     {
798 :     my @from = $cgi->radio_group(-name => 'from',
799 :     -nolabels => 1,
800 : efrank 1.8 -override => 1,
801 : efrank 1.1 -values => ["",$peg,map { $_->id2 } @sims]);
802 :    
803 :     my $target = "window$$";
804 : overbeek 1.53 my $sprout = $cgi->param('SPROUT') ? 1 : "";
805 : redwards 1.37 # RAE: added a name to the form so tha the javascript works
806 : golsen 1.18 push( @$html, $cgi->start_form( -method => 'post',
807 :     -target => $target,
808 : redwards 1.37 -action => 'fid_checked.cgi',
809 :     -name => 'fid_checked'
810 : golsen 1.18 ),
811 : overbeek 1.53 $cgi->hidden(-name => 'SPROUT', -value => $sprout),
812 : golsen 1.18 $cgi->hidden(-name => 'fid', -value => $peg),
813 :     $cgi->hidden(-name => 'user', -value => $user),
814 :     $cgi->br,
815 :     "For Selected (checked) sequences: ",
816 :     $cgi->submit('align'),
817 :     $cgi->submit('view annotations'),
818 :     $cgi->submit('show regions')
819 :     );
820 : overbeek 1.11
821 :     if ($user)
822 : golsen 1.18 { my $help_url = "Html/help_for_assignments_and_rules.html";
823 : overbeek 1.11 push ( @$html, $cgi->br, $cgi->br,
824 :     "<a href=$help_url>Help on Assignments, Rules, and Checkboxes</a>",
825 :     $cgi->br, $cgi->br,
826 :     $cgi->submit('assign/annotate')
827 :     );
828 :    
829 : efrank 1.1 if ($cgi->param('translate'))
830 :     {
831 : overbeek 1.11 push( @$html, $cgi->submit('add rules'),
832 :     $cgi->submit('check rules'),
833 :     $cgi->br
834 :     );
835 : efrank 1.1 }
836 :     }
837 :    
838 : overbeek 1.11 push( @$html, $cgi->br,
839 :     $cgi->checkbox( -name => 'checked',
840 :     -value => $peg,
841 :     -override => 1,
842 :     -checked => 1,
843 :     -label => ""
844 :     )
845 :     );
846 :    
847 :     my $col_hdrs;
848 : golsen 1.18 my $color_help = "(<A href=\"Html/similarity_region_colors.html\">colors explained</A>)";
849 : overbeek 1.11 if ($user && $cgi->param('translate'))
850 :     {
851 :     push( @$html, " ASSIGN to/Translate from/SELECT current PEG", $cgi->br,
852 :     "ASSIGN/annotate with form: ", shift @from, $cgi->br,
853 :     "ASSIGN from/Translate to current PEG: ", shift @from
854 :     );
855 : golsen 1.18 $col_hdrs = [ "ASSIGN to<hr>Translate from",
856 :     $expand_groups ? "family" : (),
857 :     $expand_groups ? "size" : (),
858 : overbeek 1.11 "Similar sequence",
859 : overbeek 1.30 "E-val<br>% iden",
860 : golsen 1.18 "region in<br>similar sequence<br>$color_help",
861 :     "region in<br>$peg<br>$color_help",
862 :     "ASSIGN from<hr>Translate to",
863 : overbeek 1.50 "In Sub",
864 : overbeek 1.11 "Function",
865 :     "Organism",
866 : golsen 1.18 ! $hide_alias ? "Aliases" : ()
867 : overbeek 1.11 ];
868 :     }
869 :     elsif ($user)
870 :     {
871 :     push( @$html, " ASSIGN to/SELECT current PEG", $cgi->br,
872 :     "ASSIGN/annotate with form: ", shift @from, $cgi->br,
873 :     "ASSIGN from current PEG: ", shift @from
874 :     );
875 : golsen 1.18 $col_hdrs = [ "ASSIGN to<hr>SELECT",
876 :     $expand_groups ? "family" : (),
877 :     $expand_groups ? "size" : (),
878 : overbeek 1.11 "Similar sequence",
879 : overbeek 1.30 "E-val<br>% iden",
880 : golsen 1.18 "region in<br>similar sequence<br>$color_help",
881 :     "region in<br>$peg<br>$color_help",
882 : overbeek 1.11 "ASSIGN from",
883 : overbeek 1.50 "In Sub",
884 : overbeek 1.11 "Function",
885 :     "Organism",
886 : golsen 1.18 ! $hide_alias ? "Aliases" : ()
887 : overbeek 1.11 ];
888 :     }
889 :     else
890 : efrank 1.1 {
891 : overbeek 1.11 push(@$html, " SELECT current PEG", $cgi->br );
892 :     $col_hdrs = [ "SELECT",
893 : golsen 1.18 $expand_groups ? "family" : (),
894 :     $expand_groups ? "size" : (),
895 : overbeek 1.11 "Similar sequence",
896 : overbeek 1.30 "E-val<br>% iden",
897 : golsen 1.18 "region in<br>similar sequence<br>$color_help",
898 :     "region in<br>$peg<br>$color_help",
899 : overbeek 1.50 "In Sub",
900 : overbeek 1.11 "Function",
901 :     "Organism",
902 : golsen 1.18 ! $hide_alias ? "Aliases" : ()
903 : overbeek 1.11 ];
904 : efrank 1.1 }
905 :    
906 : redwards 1.37 # RAE Add the check all/uncheck all boxes.
907 :     push (@$html, $cgi->br, &HTML::java_buttons("fid_checked", "checked"), $cgi->br);
908 :    
909 :    
910 : golsen 1.18 #
911 :     # Total rewrite of sim table code: cleaner program flow; omitting
912 :     # empty columns; colorizing region-of-similarity cells -- GJO
913 :     #
914 :     # Start the similarity table with "Caption" and header row
915 :    
916 :     my $ncol = @$col_hdrs;
917 :     push( @$html, "<TABLE border cols=$ncol>\n",
918 :     "\t<Caption><h2>Similarities</h2></Caption>\n",
919 :     "\t<TR>\n\t\t<TH>",
920 :     join( "</TH>\n\t\t<TH>", @$col_hdrs ),
921 :     "</TH>\n\t</TR>\n"
922 :     );
923 :    
924 :     # Add the table data, row-by-row
925 : overbeek 1.11
926 : golsen 1.18 my $alia = ! $hide_alias;
927 : overbeek 1.11 my $sim;
928 :     foreach $sim ( @sims )
929 : efrank 1.1 {
930 : golsen 1.18 my $id2 = $sim->id2;
931 : overbeek 1.29 if ((! $show_env) && ($id2 =~ /^fig\|99999/))
932 :     {
933 :     shift @from;
934 :     next;
935 :     }
936 : overbeek 1.53 my $cbox = &translatable($fig_or_sprout,$id2) ?
937 : golsen 1.18 qq(<input type=checkbox name=checked value="$id2">) : "";
938 : overbeek 1.11
939 : golsen 1.18 my( $family, $sz, $funcF, $fam_link );
940 : overbeek 1.53 if ($expand_groups && ($id2 =~ /^fig\|/) && ($family = &in_family($fig_or_sprout,$id2)))
941 : efrank 1.1 {
942 : overbeek 1.53 $sz = &sz_family($fig_or_sprout,$family);
943 :     $funcF = html_enc( &family_function($fig_or_sprout,$family) );
944 : golsen 1.18 $fam_link = scalar &HTML::family_link( $family, $user );
945 : efrank 1.1 }
946 :     else
947 :     {
948 : golsen 1.18 $family = $sz = $funcF = $fam_link = "";
949 : efrank 1.1 }
950 :    
951 :     my $id2_link = &HTML::set_prot_links($cgi,$id2);
952 : golsen 1.18 chomp $id2_link;
953 : overbeek 1.50
954 : overbeek 1.53 my @in_sub = &peg_to_subsystems($fig_or_sprout,$id2);
955 : overbeek 1.50 my $in_sub;
956 :     if (@in_sub > 0)
957 :     {
958 :     $in_sub = @in_sub;
959 :     }
960 :     else
961 :     {
962 :     $in_sub = "";
963 :     }
964 :    
965 : golsen 1.18 my $psc = $sim->psc;
966 : overbeek 1.30 my $iden = $sim->iden;
967 : golsen 1.18 my $ln1 = $sim->ln1;
968 :     my $ln2 = $sim->ln2;
969 :     my $b1 = $sim->b1;
970 :     my $e1 = $sim->e1;
971 :     my $b2 = $sim->b2;
972 :     my $e2 = $sim->e2;
973 :     my $d1 = abs($e1 - $b1) + 1;
974 :     my $d2 = abs($e2 - $b2) + 1;
975 :     my $reg1 = "$b1-$e1 (<b>$d1/$ln1</b>)";
976 :     my $color1 = match_color( $b1, $e1, $ln1 );
977 :     my $reg2 = "$b2-$e2 (<b>$d2/$ln2</b>)";
978 :     my $color2 = match_color( $b2, $e2, $ln2 );
979 :     my $radio = $user ? shift @from : undef;
980 : overbeek 1.53 my $func2 = html_enc( scalar &trans_function_of( $cgi, $fig_or_sprout, $id2, $user ) );
981 : redwards 1.37 ## RAE Added color3. This will color function tables that do not match the original
982 :     ## annotation. This makes is a lot easier to see what is different (e.g. caps/spaces, etc)
983 :     my $color3="#FFFFFF";
984 :     unless ($func2 eq $current_func) {$color3="#FFDEAD"}
985 :    
986 : golsen 1.18 if ($funcF && $funcF ne $func2) { $func2 = "$funcF<br>$func2" }
987 : golsen 1.32
988 :     #
989 :     # Colorize organisms:
990 :     #
991 : overbeek 1.53 # my $org = html_enc( &org_of($fig_or_sprout, $id2 ) );
992 :     my ($org,$oc) = &org_and_color_of($fig_or_sprout, $id2 );
993 : golsen 1.32 $org = html_enc( $org );
994 :    
995 : overbeek 1.53 my $aliases = $alia ? html_enc( join( ", ", &feature_aliasesL($fig_or_sprout,$id2) ) )
996 : golsen 1.18 : undef;
997 :    
998 :     # Okay, everything is calculated, let's "print" the row datum-by-datum:
999 :    
1000 :     push( @$html, "\t<TR>\n",
1001 : golsen 1.32 #
1002 :     # Colorize check box by Domain
1003 :     #
1004 :     "\t\t<TD Align=center Bgcolor=$oc>$cbox</TD>\n",
1005 : golsen 1.18 $expand_groups ? "\t\t<TD>$fam_link</TD>/n" : (),
1006 :     $expand_groups ? "\t\t<TD>$sz</TD>\n" : (),
1007 :     "\t\t<TD Nowrap>$id2_link</TD>\n",
1008 : overbeek 1.30 "\t\t<TD Nowrap>$psc<br>$iden\%</TD>\n",
1009 : golsen 1.18 "\t\t<TD Nowrap Bgcolor=$color2>$reg2</TD>\n",
1010 :     "\t\t<TD Nowrap Bgcolor=$color1>$reg1</TD>\n",
1011 :     $user ? "\t\t<TD Align=center>$radio</TD>\n" : (),
1012 : overbeek 1.50 "\t\t<TD>$in_sub</TD>",
1013 : redwards 1.37 "\t\t<TD Bgcolor=$color3>$func2</TD>\n",
1014 : golsen 1.32 #
1015 :     # Colorize organism by Domain
1016 :     #
1017 :     # "\t\t<TD>$org</TD>\n",
1018 :     "\t\t<TD Bgcolor=$oc>$org</TD>\n",
1019 : golsen 1.18 $alia ? "\t\t<TD>$aliases</TD>\n" : (),
1020 :     "\t</TR>\n"
1021 : overbeek 1.11 );
1022 : efrank 1.1 }
1023 : overbeek 1.11
1024 : golsen 1.18 push( @$html, "</TABLE>\n" );
1025 :     push( @$html, $cgi->end_form );
1026 : efrank 1.1 }
1027 :     }
1028 :    
1029 : golsen 1.18 #
1030 :     # Support functions for writing the similarities
1031 :     #
1032 :     # This is a sufficient set of escaping for text in HTML:
1033 :     #
1034 :    
1035 :     sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
1036 :    
1037 :     #
1038 :     # Make a background color that reflects the position and extent of a
1039 :     # matching region.
1040 :     #
1041 :     # Left side is red; right side is blue.
1042 :     # Long match is white or pastel; short match is saturated color.
1043 :     #
1044 :    
1045 :     sub match_color {
1046 :     my ( $b, $e, $n ) = @_;
1047 :     my ( $l, $r ) = ( $e > $b ) ? ( $b, $e ) : ( $e, $b );
1048 :     # my $hue = 3/4 * 0.5*($l+$r)/$n - 1/24;
1049 :     my $hue = 5/6 * 0.5*($l+$r)/$n - 1/12;
1050 :     my $cov = ( $r - $l + 1 ) / $n;
1051 :     my $sat = 1 - 10 * $cov / 9;
1052 :     # my $br = 0.8 + 0.2 * $cov;
1053 :     my $br = 1;
1054 :     rgb2html( hsb2rgb( $hue, $sat, $br ) );
1055 :     }
1056 :    
1057 :     #
1058 :     # Convert HSB to RGB. Hue is taken to be in range 0 - 1 (red to red);
1059 :     #
1060 :    
1061 :     sub hsb2rgb {
1062 :     my ( $h, $s, $br ) = @_;
1063 :     $h = 6 * ($h - floor($h)); # Hue is made cyclic modulo 1
1064 :     if ( $s > 1 ) { $s = 1 } elsif ( $s < 0 ) { $s = 0 }
1065 :     if ( $br > 1 ) { $br = 1 } elsif ( $br < 0 ) { $br = 0 }
1066 :     my ( $r, $g, $b ) = ( $h <= 3 ) ? ( ( $h <= 1 ) ? ( 1, $h, 0 )
1067 :     : ( $h <= 2 ) ? ( 2 - $h, 1, 0 )
1068 :     : ( 0, 1, $h - 2 )
1069 :     )
1070 :     : ( ( $h <= 4 ) ? ( 0, 4 - $h, 1 )
1071 :     : ( $h <= 5 ) ? ( $h - 4, 0, 1 )
1072 :     : ( 1, 0, 6 - $h )
1073 :     );
1074 :     ( ( $r * $s + 1 - $s ) * $br,
1075 :     ( $g * $s + 1 - $s ) * $br,
1076 :     ( $b * $s + 1 - $s ) * $br
1077 :     )
1078 :     }
1079 :    
1080 :     #
1081 :     # Convert an RGB value to an HTML color string:
1082 :     #
1083 :    
1084 :     sub rgb2html {
1085 :     my ( $r, $g, $b ) = @_;
1086 :     if ( $r > 1 ) { $r = 1 } elsif ( $r < 0 ) { $r = 0 }
1087 :     if ( $g > 1 ) { $g = 1 } elsif ( $g < 0 ) { $g = 0 }
1088 :     if ( $b > 1 ) { $b = 1 } elsif ( $b < 0 ) { $b = 0 }
1089 :     sprintf("\"#%02x%02x%02x\"", int(255.999*$r), int(255.999*$g), int(255.999*$b) )
1090 :     }
1091 :    
1092 :     #
1093 :     # floor could be gotten from POSIX::, but why bother?
1094 :     #
1095 :    
1096 :     sub floor {
1097 :     my $x = $_[0];
1098 :     defined( $x ) || return undef;
1099 :     ( $x >= 0 ) || ( int($x) == $x ) ? int( $x ) : -1 - int( - $x )
1100 :     }
1101 :    
1102 :    
1103 : efrank 1.1 ################# Context on the Chromosome ############################
1104 :    
1105 :     sub print_context {
1106 : overbeek 1.53 my($fig_or_sprout,$cgi,$html,$peg,$feat,$beg,$end) = @_;
1107 : olson 1.56
1108 : olson 1.57 warn "print_context ", Dumper(@_[1..$#_]);
1109 :     if ($beg eq $end) { cluck "Have zero len"; }
1110 : efrank 1.1 my($contig1,$beg1,$end1,$strand,$max_so_far,$gap,$comment,$fc,$aliases);
1111 :     my($why_related,$fid1,$sz,$color,$map,$gg,$n,$link,$in_neighborhood);
1112 :    
1113 : overbeek 1.41
1114 :     my $user = $cgi->param('user');
1115 : overbeek 1.53 my $sprout = $cgi->param('SPROUT') ? 1 : "";
1116 :     push(@$html,$cgi->start_form(-action => &cgi_url . "/chromosomal_clusters.cgi"),
1117 :     $cgi->hidden(-name => 'SPROUT', -value => $sprout),
1118 : overbeek 1.41 $cgi->hidden(-name => "prot", -value => $peg),
1119 : overbeek 1.44 $cgi->hidden(-name => "uni", -value => 1),
1120 : overbeek 1.41 $cgi->hidden(-name => "user", -value => $user));
1121 :    
1122 : efrank 1.1 $why_related = "";
1123 : overbeek 1.53 my %in_cluster = map { $_ => 1 } &in_cluster_with($fig_or_sprout,$peg);
1124 : efrank 1.1
1125 : overbeek 1.41 my $col_hdrs = ["fid","starts","ends","size","","gap","req.<br>in<br>pin","fc","neigh","comment","aliases","Related"];
1126 : efrank 1.1 my($tab) = [];
1127 :     my $genes = [];
1128 :    
1129 : overbeek 1.53 my $peg_function = &trans_function_of($cgi,$fig_or_sprout,$peg,$user);
1130 : efrank 1.1
1131 :     my($role,$role1,%related_roles);
1132 : overbeek 1.53 foreach $role (&roles_of_function($peg_function))
1133 : efrank 1.1 {
1134 : overbeek 1.53 foreach $role1 (&neighborhood_of_role($fig_or_sprout,$role))
1135 : efrank 1.1 {
1136 :     $related_roles{$role1} = 1;
1137 :     }
1138 :     }
1139 :    
1140 :     foreach $fid1 (@$feat)
1141 :     {
1142 :     $fc = $in_cluster{$fid1} ? &pin_link($cgi,$fid1) : "";
1143 : overbeek 1.53 my $aliases = join( ', ', &feature_aliasesL($fig_or_sprout,$fid1) );
1144 :     ($contig1,$beg1,$end1) = &boundaries_of($fig_or_sprout,&feature_locationS($fig_or_sprout,$fid1));;
1145 : efrank 1.1 $strand = ($beg1 < $end1) ? "+" : "-";
1146 :    
1147 : overbeek 1.53 my $function = &function_ofS($fig_or_sprout,$fid1);
1148 : olson 1.48 my $uniprot;
1149 :     if ($aliases =~ /(uni[^,]+)/) {
1150 :     # print STDERR "$1\n";
1151 :     $uniprot = $1;
1152 :     }
1153 :     my $info = join ('<br/>', "<b>PEG:</b> ".$fid1, "<b>Contig:</b> ".$contig1, "<b>Begin:</b> ".$beg1, "<b>End:</b> ".$end1,$function ? "<b>Function:</b> ".$function : '', $uniprot ? "<b>Uniprot ID:</b> ".$uniprot : '');
1154 :    
1155 :    
1156 : efrank 1.1 if ($fid1 eq $peg) { $color = "green" }
1157 :     elsif ($fc) { $color = "blue" }
1158 :     else { $color = "red" }
1159 :    
1160 :     if ($fid1 =~ /peg\.(\d+)$/)
1161 :     {
1162 :     $n = $1;
1163 :     $link = $cgi->url() . "?prot=$fid1&user=$user";
1164 :     }
1165 :     elsif ($fid1 =~ /\.([a-z]+)\.\d+$/)
1166 :     {
1167 :     $n = uc $1;
1168 :     $link = "";
1169 :     }
1170 :     else
1171 :     {
1172 :     $n ="";
1173 :     $link = "";
1174 :     }
1175 :    
1176 : overbeek 1.53 push(@$genes,[&min($beg1,$end1),&max($beg1,$end1),($strand eq "+") ? "rightArrow" : "leftArrow", $color,$n,$link,$info]);
1177 : efrank 1.1 if ($max_so_far)
1178 :     {
1179 : overbeek 1.53 $gap = (&min($beg1,$end1) - $max_so_far) - 1;
1180 : efrank 1.1 }
1181 :     else
1182 :     {
1183 :     $gap = "";
1184 :     }
1185 : overbeek 1.53 $max_so_far = &max($beg1,$end1);
1186 : efrank 1.1
1187 :    
1188 :     $in_neighborhood = "";
1189 : overbeek 1.53 if (&ftype($fid1) eq "peg")
1190 : efrank 1.1 {
1191 : overbeek 1.53 $comment = &trans_function_of($cgi,$fig_or_sprout,$fid1,$user);
1192 :     foreach $role (&roles_of_function($comment))
1193 : efrank 1.1 {
1194 :     if ($related_roles{$role})
1195 :     {
1196 :     $in_neighborhood = "*";
1197 :     }
1198 :     }
1199 :     }
1200 :     else
1201 :     {
1202 :     $comment = "";
1203 :     }
1204 : overbeek 1.53 $comment = &set_map_links($fig_or_sprout,&genome_of($fid1),$comment);
1205 : overbeek 1.17 if ($fid1 eq $peg)
1206 :     {
1207 : overbeek 1.20 $comment = "\@bgcolor=\"#00FF00\":$comment";
1208 : overbeek 1.17 }
1209 : efrank 1.1 $sz = abs($end1-$beg1)+1;
1210 :    
1211 : overbeek 1.42 my $must_have = (($fid1 eq $peg) || (! $fc)) ? "" : $cgi->checkbox(-name => 'must_have',
1212 :     -value => $fid1,
1213 :     -checked => 0,
1214 :     -override => 1,
1215 :     -label => "");
1216 : overbeek 1.41
1217 :     push(@$tab,[&HTML::fid_link($cgi,$fid1,"local"),$beg1,$end1,$sz,$strand,$gap,
1218 :     $must_have,
1219 :     $fc,$in_neighborhood,
1220 : overbeek 1.33 $comment,&HTML::set_prot_links($cgi,$aliases),$why_related]);
1221 : efrank 1.1 }
1222 : overbeek 1.27 push(@$html,&HTML::make_table($col_hdrs,$tab,"Context on contig $contig1"));
1223 : overbeek 1.41 push(@$html,$cgi->br,$cgi->submit('pin with checked genes'),$cgi->end_form,$cgi->br);
1224 : overbeek 1.53 return ($beg,$end,$genes);
1225 :     }
1226 :    
1227 :     sub print_graphics_context {
1228 :     my($beg,$end,$genes,$html) = @_;
1229 :    
1230 :     my $map = ["",$beg,$end,$genes];
1231 :     my $gg = [$map];
1232 : overbeek 1.2 push(@$html,@{ &GenoGraphics::render($gg,700,4,0,1) });
1233 : efrank 1.1 return;
1234 :     }
1235 :    
1236 :     sub assign_link {
1237 :     my($cgi,$func,$existing_func) = @_;
1238 :     my($assign_url,$assign_link);
1239 :    
1240 :     if ($func && ((! $existing_func) || ($existing_func ne $func)))
1241 :     {
1242 :     $cgi->delete('request');
1243 :     $assign_url = $cgi->self_url() . "&request=fast_assign&func=$func"; ## must encode
1244 :     $assign_link = "<a href=\"$assign_url\">&nbsp;<=&nbsp;</a>";
1245 :     }
1246 :     else
1247 :     {
1248 :     $assign_link = "";
1249 :     }
1250 :     return $assign_link;
1251 :     }
1252 :    
1253 :     sub pin_link {
1254 :     my($cgi,$peg) = @_;
1255 :     my $user = $cgi->param('user');
1256 :     $user = defined($user) ? $user : "";
1257 :    
1258 : overbeek 1.53 my $sprout = $cgi->param('SPROUT') ? 1 : "";
1259 :     my $cluster_url = "chromosomal_clusters.cgi?prot=$peg&user=$user&uni=1&SPROUT=$sprout";
1260 : efrank 1.1 my $cluster_link = "<a href=\"$cluster_url\">*</a>";
1261 :     return $cluster_link;
1262 :     }
1263 :    
1264 :     sub set_map_links {
1265 : overbeek 1.53 my($fig_or_sprout,$org,$func) = @_;
1266 : efrank 1.1
1267 :     if ($func =~ /^(.*)(\d+\.\d+\.\d+\.\d+)(.*)$/)
1268 :     {
1269 :     my $before = $1;
1270 :     my $ec = $2;
1271 :     my $after = $3;
1272 : overbeek 1.53 return &set_map_links($fig_or_sprout,$org,$before) . &set_ec_to_maps($fig_or_sprout,$org,$ec) . &set_map_links($fig_or_sprout,$org,$after);
1273 : efrank 1.1 }
1274 :     return $func;
1275 :     }
1276 :    
1277 :     sub set_ec_to_maps {
1278 : overbeek 1.53 my($fig_or_sprout,$org,$ec) = @_;
1279 : efrank 1.1
1280 : overbeek 1.53 my @maps = &ec_to_maps($fig_or_sprout,$ec);
1281 : efrank 1.1 if (@maps > 0)
1282 :     {
1283 :     $cgi->delete('request');
1284 :     my $url = $cgi->self_url() . "&request=ec_to_maps&ec=$ec&org=$org";
1285 :     my $link = "<a href=\"$url\">$ec</a>";
1286 :     return $link;
1287 :     }
1288 :     return $ec;
1289 :     }
1290 :    
1291 :     sub show_ec_to_maps {
1292 : overbeek 1.53 my($fig_or_sprout,$cgi,$html,$ec) = @_;
1293 : efrank 1.1
1294 :     my $ec = $cgi->param('ec');
1295 :     if (! $ec)
1296 :     {
1297 :     push(@$html,$cgi->h1("Missing EC number"));
1298 :     return;
1299 :     }
1300 :    
1301 : overbeek 1.53 my @maps = &ec_to_maps($fig_or_sprout,$ec);
1302 : efrank 1.1 if (@maps > 0)
1303 :     {
1304 :     my $col_hdrs = ["map","metabolic topic"];
1305 :     my $map;
1306 : overbeek 1.53 my $tab = [map { $map = $_; [&map_link($cgi,$map),&map_name($fig_or_sprout,$map)] } @maps];
1307 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"$ec: " . &ec_name($fig_or_sprout,$ec)));
1308 : efrank 1.1 }
1309 :     }
1310 :    
1311 :     sub map_link {
1312 :     my($cgi,$map) = @_;
1313 :    
1314 :     $cgi->delete('request');
1315 :     my $url = $cgi->self_url() . "&request=link_to_map&map=$map";
1316 :     my $link = "<a href=\"$url\">$map</a>";
1317 :     return $link;
1318 :     }
1319 :    
1320 :     sub link_to_map {
1321 : overbeek 1.53 my($fig_or_sprout,$cgi,$html) = @_;
1322 : efrank 1.1
1323 :     my $map = $cgi->param('map');
1324 :     if (! $map)
1325 :     {
1326 :     push(@$html,$cgi->h1("Missing Map"));
1327 :     return;
1328 :     }
1329 :    
1330 :     my $org = $cgi->param('org');
1331 :     if (! $org)
1332 :     {
1333 :     push(@$html,$cgi->h1("Missing Org Parameter"));
1334 :     return;
1335 :     }
1336 :     my$user = $cgi->param('user');
1337 :     $user = $user ? $user : "";
1338 :    
1339 :     $ENV{"REQUEST_METHOD"} = "GET";
1340 :     $ENV{"QUERY_STRING"} = "user=$user&map=$map&org=$org";
1341 :     my @out = `./show_kegg_map.cgi`;
1342 :     &HTML::trim_output(\@out);
1343 :     push(@$html,@out);
1344 :     }
1345 :    
1346 :     sub aa_sequence {
1347 : overbeek 1.53 my($fig_or_sprout,$cgi,$html,$prot) = @_;
1348 : efrank 1.1 my($seq,$func,$i);
1349 :    
1350 : golsen 1.19 unshift @$html, "<TITLE>The SEED: Protein Sequence</TITLE>\n";
1351 : overbeek 1.53 if ($seq = &get_translation($fig_or_sprout,$prot))
1352 : efrank 1.1 {
1353 : overbeek 1.53 $func = &function_ofS($fig_or_sprout,$prot,$cgi->param('user'));
1354 : efrank 1.1 push(@$html,$cgi->pre,">$prot $func\n");
1355 :     for ($i=0; ($i < length($seq)); $i += 60)
1356 :     {
1357 :     if ($i > (length($seq) - 60))
1358 :     {
1359 :     push(@$html,substr($seq,$i) . "\n");
1360 :     }
1361 :     else
1362 :     {
1363 :     push(@$html,substr($seq,$i,60) . "\n");
1364 :     }
1365 :     }
1366 :     push(@$html,$cgi->end_pre);
1367 :     }
1368 :     else
1369 :     {
1370 :     push(@$html,$cgi->h1("No translation available for $prot"));
1371 :     }
1372 :     }
1373 :    
1374 :     sub dna_sequence {
1375 : overbeek 1.53 my($fig_or_sprout,$cgi,$html,$fid) = @_;
1376 : efrank 1.1 my($seq,$func,$i);
1377 :    
1378 : golsen 1.19 unshift @$html, "<TITLE>The SEED: Nucleotide Sequence</TITLE>\n";
1379 : overbeek 1.53 if ($seq = &dna_seq($fig_or_sprout,&genome_of($fid),&feature_locationS($fig_or_sprout,$fid)))
1380 : efrank 1.1 {
1381 : overbeek 1.53 $func = &function_ofS($fig_or_sprout,$prot,$cgi->param('user'));
1382 : efrank 1.1 push(@$html,$cgi->pre,">$fid $func\n");
1383 :     for ($i=0; ($i < length($seq)); $i += 60)
1384 :     {
1385 :     if ($i > (length($seq) - 60))
1386 :     {
1387 :     push(@$html,substr($seq,$i) . "\n");
1388 :     }
1389 :     else
1390 :     {
1391 :     push(@$html,substr($seq,$i,60) . "\n");
1392 :     }
1393 :     }
1394 :     push(@$html,$cgi->end_pre);
1395 :     }
1396 :     else
1397 :     {
1398 :     push(@$html,$cgi->h1("No DNA sequence available for $fid"));
1399 :     }
1400 :     }
1401 :    
1402 :     sub show_fusions {
1403 : overbeek 1.53 my($fig_or_sprout,$cgi,$html,$prot) = @_;
1404 : efrank 1.1
1405 : overbeek 1.22 my $user = $cgi->param('user');
1406 :     $user = $user ? $user : "";
1407 : overbeek 1.53 my $sprout = $cgi->param('SPROUT') ? 1 : "";
1408 :    
1409 : efrank 1.1 $ENV{"REQUEST_METHOD"} = "GET";
1410 : overbeek 1.53 $ENV{"QUERY_STRING"} = "peg=$prot&user=$user&SPROUT=$sprout";
1411 : efrank 1.1 my @out = `./fusions.cgi`;
1412 :     print join("",@out);
1413 :     exit;
1414 : overbeek 1.2 }
1415 :    
1416 : overbeek 1.53 ###########################################################################
1417 : overbeek 1.2 sub print_compared_regions {
1418 : overbeek 1.53 my($fig_or_sprout,$cgi,$html,$peg) = @_;
1419 :    
1420 :     my $sz_region = $cgi->param('sz_region');
1421 :     $sz_region = $sz_region ? $sz_region : 16000;
1422 :    
1423 :     my $num_close = $cgi->param('num_close');
1424 :     $num_close = $num_close ? $num_close : 5;
1425 : overbeek 1.2
1426 : overbeek 1.53 my @closest_pegs = &closest_pegs($fig_or_sprout,$peg,$num_close);
1427 : overbeek 1.40
1428 : overbeek 1.2 if (@closest_pegs > 0)
1429 :     {
1430 : overbeek 1.53 if (&possibly_truncated($fig_or_sprout,$peg))
1431 : overbeek 1.2 {
1432 :     push(@closest_pegs,&possible_extensions($peg,\@closest_pegs));
1433 :     }
1434 : overbeek 1.53 @closest_pegs = &sort_fids_by_taxonomy($fig_or_sprout,@closest_pegs);
1435 : overbeek 1.2 unshift(@closest_pegs,$peg);
1436 :     my @all_pegs = ();
1437 : overbeek 1.53 my $gg = &build_maps($fig_or_sprout,\@closest_pegs,\@all_pegs,$sz_region);
1438 : olson 1.48 #warn Dumper($gg);
1439 : overbeek 1.2 my $color_sets = &cluster_genes(\@all_pegs,$peg);
1440 :     &set_colors_text_and_links($gg,\@all_pegs,$color_sets);
1441 : overbeek 1.35 ################################### add commentary capability
1442 :    
1443 : overbeek 1.53 my @parm_reset_form = ($cgi->hr);
1444 :     push(@parm_reset_form,$cgi->start_form(-action => &cgi_url . "/protein.cgi" ));
1445 :     my $param;
1446 :     foreach $param ($cgi->param())
1447 :     {
1448 :     next if (($param eq "sz_region") || ($param eq "num_close"));
1449 :     push(@parm_reset_form,$cgi->hidden(-name => $param, -value => $cgi->param($param)));
1450 :     }
1451 :     push(@parm_reset_form,
1452 :     "size region: ",
1453 :     $cgi->textfield(-name => 'sz_region', -size => 10, -value => $sz_region, -override => 1),
1454 :     "&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; ",
1455 :     "Number close genomes: ",
1456 :     $cgi->textfield(-name => 'num_close', -size => 4, -value => $num_close, -override => 1),
1457 :     $cgi->br,
1458 :     $cgi->submit('Reset Parameters')
1459 :     );
1460 :     push(@parm_reset_form,$cgi->end_form);
1461 :     push(@$html,@parm_reset_form);
1462 :     ####
1463 : overbeek 1.35 my @commentary_form = ();
1464 :     my $ctarget = "window$$";
1465 :     my $user = $cgi->param('user');
1466 : overbeek 1.53 my $sprout = $cgi->param('SPROUT') ? 1 : "";
1467 :    
1468 : overbeek 1.35 push(@commentary_form,$cgi->start_form(-target => $ctarget,
1469 : overbeek 1.53 -action => &cgi_url . "/chromosomal_clusters.cgi"
1470 : overbeek 1.35 ));
1471 : overbeek 1.53
1472 :     push(@commentary_form,$cgi->hidden(-name => 'SPROUT', -value => $sprout),
1473 :     $cgi->hidden(-name => "request", -value => "show_commentary"));
1474 : overbeek 1.35 push(@commentary_form,$cgi->hidden(-name => "prot", -value => $peg));
1475 : overbeek 1.44 push(@commentary_form,$cgi->hidden(-name => "uni", -value => 1));
1476 : overbeek 1.35 push(@commentary_form,$cgi->hidden(-name => "user", -value => $user));
1477 :    
1478 :     my($gene,$n,%how_many,$val,@vals,$x);
1479 :     my($i,$map);
1480 :     @vals = ();
1481 :     for ($i=(@$gg - 1); ($i >= 0); $i--)
1482 :     {
1483 :     my @vals1 = ();
1484 :     $map = $gg->[$i];
1485 :     my $found = 0;
1486 :     my $got_red = 0;
1487 :     undef %how_many;
1488 :     foreach $gene (@{$map->[3]})
1489 :     {
1490 :     if (($x = $gene->[3]) ne "grey")
1491 :     {
1492 :     $n = $gene->[4];
1493 :     if ($n == 1) { $got_red = 1 }
1494 :     $how_many{$n}++;
1495 :     $gene->[5] =~ /(fig\|\d+\.\d+\.peg\.\d+)/;
1496 :     $val = join("@",($n,$i,$1,$map->[0],$how_many{$n}));
1497 :     push(@vals1,$val);
1498 :     $found++;
1499 :     }
1500 :     }
1501 :    
1502 :     if (! $got_red)
1503 :     {
1504 :     splice(@$gg,$i,1);
1505 :     }
1506 :     else
1507 :     {
1508 :     push(@vals,@vals1);
1509 :     }
1510 :     }
1511 :    
1512 :     if (@$gg == 0)
1513 :     {
1514 :     push(@$html,$cgi->h1("Sorry, no pins worked out"));
1515 :     }
1516 :     else
1517 :     {
1518 :     push(@commentary_form,$cgi->hidden(-name => "show", -value => [@vals]));
1519 :     push(@commentary_form,$cgi->submit('commentary'));
1520 :     push(@commentary_form,$cgi->end_form());
1521 :     push(@$html,@commentary_form);
1522 :     }
1523 :     ################################################################end commentary
1524 : overbeek 1.2 push(@$html,@{ &GenoGraphics::render($gg,700,4,0,2) });
1525 : olson 1.48 push @$html, &FIGGenDB::linkClusterGenDB($peg);
1526 : overbeek 1.2 }
1527 :     }
1528 :    
1529 :     sub closest_pegs {
1530 : overbeek 1.53 my($fig_or_sprout,$peg,$n) = @_;
1531 : overbeek 1.2 my($id2,$d,$peg2,$i);
1532 :    
1533 : overbeek 1.53 my @closest = map { $id2 = $_->id2; ($id2 =~ /^fig\|/) ? $id2 : () } &sims($fig_or_sprout,$peg,5,1.0e-20,"all");
1534 : overbeek 1.2
1535 :     if (@closest > $n) { $#closest = $n-1 }
1536 :     my %closest = map { $_ => 1 } @closest;
1537 : overbeek 1.53 my @pinned_to = grep { $_ ne $peg} &in_pch_pin_with($fig_or_sprout,$peg);
1538 :     my $g1 = &genome_of($peg);
1539 : overbeek 1.2 @pinned_to =
1540 :     map {$_->[1] }
1541 :     sort { $a->[0] <=> $b->[0] }
1542 : overbeek 1.53 map { $peg2 = $_; $d = &crude_estimate_of_distance($fig_or_sprout,$g1,&genome_of($peg2)); [$d,$peg2] }
1543 : overbeek 1.2 @pinned_to;
1544 :    
1545 :     for ($i=0; ($i < @pinned_to) && ($i < $n); $i++)
1546 :     {
1547 :     $closest{$pinned_to[$i]} = 1;
1548 :     }
1549 :     return return keys(%closest);
1550 :     }
1551 :    
1552 :     sub build_maps {
1553 : overbeek 1.53 my($fig_or_sprout,$pinned_pegs,$all_pegs,$sz_region) = @_;
1554 : overbeek 1.2 my($gg,$loc,$contig,$beg,$end,$mid,$min,$max,$genes,$feat,$fid);
1555 :     my($contig1,$beg1,$end1,$map,$peg);
1556 :    
1557 :     $gg = [];
1558 :     foreach $peg (@$pinned_pegs)
1559 :     {
1560 : overbeek 1.53 $loc = &feature_locationS($fig_or_sprout,$peg);
1561 :     ($contig,$beg,$end) = &boundaries_of($fig_or_sprout,$loc);
1562 : overbeek 1.2 if ($contig && $beg && $end)
1563 :     {
1564 :     $mid = int(($beg + $end) / 2);
1565 : overbeek 1.53 $min = int($mid - ($sz_region / 2));
1566 :     $max = int($mid + ($sz_region / 2));
1567 : overbeek 1.2 $genes = [];
1568 : overbeek 1.53 ($feat,undef,undef) = &genes_in_region($fig_or_sprout,&genome_of($peg),$contig,$min,$max);
1569 : overbeek 1.2 foreach $fid (@$feat)
1570 :     {
1571 : overbeek 1.53 ($contig1,$beg1,$end1) = &boundaries_of($fig_or_sprout,&feature_locationS($fig_or_sprout,$fid));
1572 : overbeek 1.2 $beg1 = &in_bounds($min,$max,$beg1);
1573 :     $end1 = &in_bounds($min,$max,$end1);
1574 : overbeek 1.53 my $aliases = join( ', ', &feature_aliasesL($fig_or_sprout,$fid) );
1575 :     my $function = &function_ofS($fig_or_sprout,$fid);
1576 : olson 1.48 my $uniprot;
1577 :     if ($aliases =~ /(uni[^,]+)/) {
1578 :     $uniprot = $1;
1579 :     }
1580 :     my $info = join ('<br/>', "<b>PEG:</b> ".$fid, "<b>Contig:</b> ".$contig1, "<b>Begin:</b> ".$beg1, "<b>End:</b> ".$end1,$function ? "<b>Function:</b> ".$function : '', $uniprot ? "<b>Uniprot ID:</b> ".$uniprot : '');
1581 :    
1582 : overbeek 1.53 my $sprout = $cgi->param('SPROUT') ? 1 : "";
1583 :     my $fmg = join ('<br/>', "<a href=\&quot;protein.cgi?SPROUT=$sprout&compare_region=1\&prot=$fid\&user=\&quot>show</a>",
1584 :     "<a onClick=\&quot;setValue('bound1', '$fid'); return false;\&quot;>set bound 1</a>",
1585 :     "<a onClick=\&quot;setValue('bound2', '$fid'); return false;\&quot;>set bound 2</a>",
1586 :     "<a onClick=\&quot;setValue('candidates', '$fid'); return false;\&quot;>set candidate</a>");
1587 :    
1588 :     push(@$genes,[&min($beg1,$end1),
1589 :     &max($beg1,$end1),
1590 : overbeek 1.2 ($beg1 < $end1) ? "rightArrow" : "leftArrow",
1591 :     "grey",
1592 :     "",
1593 : olson 1.48 $fid,
1594 :     $info, $fmg]);
1595 : overbeek 1.2
1596 :     if ($fid =~ /peg/)
1597 :     {
1598 :     push(@$all_pegs,$fid);
1599 :     }
1600 :     }
1601 : overbeek 1.53 $map = [&abbrev(&org_of($fig_or_sprout,$peg)),0,$max+1-$min,
1602 : overbeek 1.2 ($beg < $end) ? &decr_coords($genes,$min) : &flip_map($genes,$min,$max)];
1603 :     push(@$gg,$map);
1604 :     }
1605 :     }
1606 : overbeek 1.55 &GenoGraphics::disambiguate_maps($gg);
1607 : overbeek 1.2 return $gg;
1608 :     }
1609 :    
1610 :     sub in {
1611 :     my($x,$xL) = @_;
1612 :     my($i);
1613 :    
1614 :     for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
1615 :     return ($i < @$xL);
1616 :     }
1617 :    
1618 :     sub in_bounds {
1619 :     my($min,$max,$x) = @_;
1620 :    
1621 :     if ($x < $min) { return $min }
1622 :     elsif ($x > $max) { return $max }
1623 :     else { return $x }
1624 :     }
1625 :    
1626 :     sub decr_coords {
1627 :     my($genes,$min) = @_;
1628 :     my($gene);
1629 :    
1630 :     foreach $gene (@$genes)
1631 :     {
1632 :     $gene->[0] -= $min;
1633 :     $gene->[1] -= $min;
1634 :     }
1635 :     return $genes;
1636 :     }
1637 :    
1638 :     sub flip_map {
1639 :     my($genes,$min,$max) = @_;
1640 :     my($gene);
1641 :    
1642 :     foreach $gene (@$genes)
1643 :     {
1644 :     ($gene->[0],$gene->[1]) = ($max - $gene->[1],$max - $gene->[0]);
1645 :     $gene->[2] = ($gene->[2] eq "rightArrow") ? "leftArrow" : "rightArrow";
1646 :     }
1647 :     return $genes;
1648 :     }
1649 :    
1650 :     sub cluster_genes {
1651 :     my($all_pegs,$peg) = @_;
1652 :     my(%seen,$i,$j,$k,$x,$cluster,$conn,$pegI,$red_set);
1653 :    
1654 :     my @color_sets = ();
1655 :    
1656 :     $conn = &get_connections_by_similarity($all_pegs);
1657 :     for ($i=0; ($i < @$all_pegs); $i++)
1658 :     {
1659 :     if ($all_pegs->[$i] eq $peg) { $pegI = $i }
1660 :     if (! $seen{$i})
1661 :     {
1662 :     $cluster = [$i];
1663 :     $seen{$i} = 1;
1664 :     for ($j=0; ($j < @$cluster); $j++)
1665 :     {
1666 :     $x = $conn->{$cluster->[$j]};
1667 :     foreach $k (@$x)
1668 :     {
1669 :     if (! $seen{$k})
1670 :     {
1671 :     push(@$cluster,$k);
1672 :     $seen{$k} = 1;
1673 :     }
1674 :     }
1675 :     }
1676 :    
1677 :     if ((@$cluster > 1) || ($cluster->[0] eq $pegI))
1678 :     {
1679 :     push(@color_sets,$cluster);
1680 :     }
1681 :     }
1682 :     }
1683 :     for ($i=0; ($i < @color_sets) && (! &in($pegI,$color_sets[$i])); $i++) {}
1684 :     $red_set = $color_sets[$i];
1685 :     splice(@color_sets,$i,1);
1686 :     @color_sets = sort { @$b <=> @$a } @color_sets;
1687 :     unshift(@color_sets,$red_set);
1688 :    
1689 :     my $color_sets = {};
1690 :     for ($i=0; ($i < @color_sets); $i++)
1691 :     {
1692 :     foreach $x (@{$color_sets[$i]})
1693 :     {
1694 :     $color_sets->{$all_pegs->[$x]} = $i;
1695 :     }
1696 :     }
1697 :     return $color_sets;
1698 :     }
1699 :    
1700 :     sub get_connections_by_similarity {
1701 :     my($all_pegs) = @_;
1702 : overbeek 1.40 my($i,$j,$tmp,$peg,%pos_of);
1703 :     my($sim,%conn,$x,$y);
1704 : overbeek 1.2
1705 :     for ($i=0; ($i < @$all_pegs); $i++)
1706 :     {
1707 : overbeek 1.53 $tmp = &maps_to_id($fig_or_sprout,$all_pegs->[$i]);
1708 : overbeek 1.5 push(@{$pos_of{$tmp}},$i); # map the representative in nr to subscript in all_pegs
1709 :     if ($tmp ne $all_pegs->[$i])
1710 : overbeek 1.2 {
1711 :     push(@{$pos_of{$all_pegs->[$i]}},$i);
1712 :     }
1713 :     }
1714 :    
1715 : overbeek 1.40 foreach $y (keys(%pos_of))
1716 :     {
1717 :     $x = $pos_of{$y};
1718 :     for ($i=0; ($i < @$x); $i++)
1719 :     {
1720 :     for ($j=$i+1; ($j < @$x); $j++)
1721 :     {
1722 :     push(@{$conn{$x->[$i]}},$x->[$j]);
1723 :     push(@{$conn{$x->[$j]}},$x->[$i]);
1724 :     }
1725 :     }
1726 :     }
1727 :    
1728 : overbeek 1.2 for ($i=0; ($i < @$all_pegs); $i++)
1729 :     {
1730 : overbeek 1.53 foreach $sim (&sims($fig_or_sprout,$all_pegs->[$i],500,1.0e-5,"raw"))
1731 : overbeek 1.2 {
1732 :     if (defined($x = $pos_of{$sim->id2}))
1733 :     {
1734 :     foreach $y (@$x)
1735 :     {
1736 :     push(@{$conn{$i}},$y);
1737 :     }
1738 :     }
1739 :     }
1740 :     }
1741 :     return \%conn;
1742 :     }
1743 :    
1744 :     sub set_colors_text_and_links {
1745 :     my($gg,$all_pegs,$color_sets) = @_;
1746 :     my($map,$gene,$peg,$color);
1747 :    
1748 :     foreach $map (@$gg)
1749 :     {
1750 :     foreach $gene (@{$map->[3]})
1751 :     {
1752 :     $peg = $gene->[5];
1753 :     if (defined($color = $color_sets->{$peg}))
1754 :     {
1755 : overbeek 1.35 $gene->[3] = ($color == 0) ? "red" : "color$color";
1756 : overbeek 1.2 $gene->[4] = $color + 1;
1757 :     }
1758 :     $gene->[5] = &peg_url($cgi,$peg);
1759 :     }
1760 :     }
1761 :     }
1762 :    
1763 :     sub peg_url {
1764 :     my($cgi,$peg) = @_;
1765 :    
1766 :     my $prot = $cgi->param('prot');
1767 :     $cgi->delete('prot');
1768 :     my $url = $cgi->self_url() . "&prot=$peg&compare_region=1";
1769 :     $cgi->delete('prot');
1770 :     $cgi->param(-name => 'prot', -value => $prot);
1771 :    
1772 :     return $url;
1773 :     }
1774 :    
1775 :     sub possible_extensions {
1776 :     my($peg,$closest_pegs) = @_;
1777 :     my($g,$sim,$id2,$peg1,%poss);
1778 :    
1779 : overbeek 1.53 $g = &genome_of($peg);
1780 : overbeek 1.2
1781 :     foreach $peg1 (@$closest_pegs)
1782 :     {
1783 : overbeek 1.53 if ($g ne &genome_of($peg1))
1784 : overbeek 1.2 {
1785 : overbeek 1.53 foreach $sim (&sims($fig_or_sprout,$peg1,500,1.0e-5,"all"))
1786 : overbeek 1.2 {
1787 :     $id2 = $sim->id2;
1788 : overbeek 1.53 if (($id2 ne $peg) && ($id2 =~ /^fig\|$g\./) && &possibly_truncated($fig_or_sprout,$id2))
1789 : overbeek 1.2 {
1790 :     $poss{$id2} = 1;
1791 :     }
1792 :     }
1793 :     }
1794 :     }
1795 :     return keys(%poss);
1796 : efrank 1.1 }
1797 : overbeek 1.53
1798 :     sub display_page {
1799 :     my($fig_or_sprout,$cgi,$html) = @_;
1800 :    
1801 :     if (ref($html) eq "ARRAY")
1802 :     {
1803 :     &HTML::show_page($cgi,$html);
1804 :     }
1805 :     else
1806 :     {
1807 : olson 1.56 warn Dumper($html);
1808 : olson 1.57 if ($cgi->param('SPROUT'))
1809 : overbeek 1.53 {
1810 : olson 1.57 print "Content-Type: text/html\n";
1811 :     print "\n";
1812 :     my $templ = "$FIG_Config::fig/CGI/Html/Protein_tmpl.html";
1813 :     my $page = new PageBuilder($templ, $html);
1814 :     print $page->Build($templ, $html);
1815 :     $page->Finish();
1816 : olson 1.56 # &HTML::BuildPage($html);
1817 : overbeek 1.53 }
1818 :     else
1819 :     {
1820 :     my $gathered = [];
1821 :    
1822 :     my $section;
1823 :     foreach $section (qw( javascript
1824 :     general
1825 :     translate_status
1826 :     contig_context
1827 :     context_graphic
1828 :     subsys_connections
1829 :     assgn_for_equiv_prots
1830 :     links
1831 :     services
1832 :     kv_pairs
1833 :     compare_region
1834 :     similarities
1835 :     tools
1836 :     )
1837 :     )
1838 :     {
1839 :     if (@{$html->{$section}} > 0)
1840 :     {
1841 :     push(@$gathered,@{$html->{$section}});
1842 :     push(@$gathered,$cgi->hr);
1843 :     }
1844 :     }
1845 :     pop @$gathered;
1846 :     &HTML::show_page($cgi,$gathered);
1847 :     }
1848 :     }
1849 :     }
1850 :    
1851 :     sub show_html_followed_by_initial {
1852 :     my($fig_or_sprout,$cgi,$html,$prot) = @_;
1853 :    
1854 :     my %html = ( general => [],
1855 :     contig_context => [],
1856 :     context_graphic => [],
1857 :     subsys_connections => [],
1858 :     links => [],
1859 :     services => [],
1860 :     translate_status => [],
1861 :     tools => [],
1862 :     kv_pairs => [],
1863 :     similarities => [],
1864 :     assgn_for_equiv_prots => [],
1865 :     javascript => [],
1866 :     compare_region => []
1867 :     );
1868 :    
1869 :     push(@{$html{general}},@$html);
1870 :     $html = \%html;
1871 :     &show_initial($fig_or_sprout,$cgi,$html,$prot);
1872 :     return $html;
1873 :     }
1874 :    
1875 :     sub translation_piece {
1876 :     my($fig_or_sprout,$cgi,$html) = @_;
1877 :    
1878 :     my $msg;
1879 :     my $url = $cgi->self_url();
1880 :     if ($cgi->param('translate')) {
1881 :     $url =~ s/[;&]translate(=[^;&])?//i or $url =~ s/translate(=[^;&])?[;&]//i;
1882 :     $msg = "Turn Off Function Translation";
1883 :     }
1884 :     else
1885 :     {
1886 :     $url .= ";translate=1";
1887 :     $msg = "Translate Function Assignments";
1888 :     }
1889 :     push(@$html, "<a href=\"$url\">$msg</a><br>\n");
1890 :     }
1891 :    
1892 :    
1893 :     #######################################################################################
1894 :    
1895 :     sub by_alias {
1896 :     my($fig_or_sprout,$prot) = @_;
1897 :     return $fig_or_sprout->by_alias($prot);
1898 :     }
1899 :    
1900 :     sub org_of {
1901 :     my($fig_or_sprout,$prot) = @_;
1902 :    
1903 :     return $fig_or_sprout->org_of($prot);
1904 :     }
1905 :    
1906 :     sub is_real_feature {
1907 :     my($fig_or_sprout,$prot) = @_;
1908 :    
1909 :     return $fig_or_sprout->is_real_feature($prot);
1910 :     }
1911 :    
1912 :     sub coupling_and_evidence {
1913 :     my($fig_or_sprout,$peg,$bound,$sim_cutoff,$coupling_cutoff) = @_;
1914 :    
1915 :     return $fig_or_sprout->coupling_and_evidence($peg,$bound,$sim_cutoff,$coupling_cutoff,"keep");
1916 :     }
1917 :    
1918 :     sub feature_locationS {
1919 :     my($fig_or_sprout,$peg) = @_;
1920 :    
1921 :     return scalar $fig_or_sprout->feature_location($peg);
1922 :     }
1923 :    
1924 :     sub boundaries_of {
1925 :     my($fig_or_sprout,$loc) = @_;
1926 :    
1927 :     return $fig_or_sprout->boundaries_of($loc);
1928 :     }
1929 :    
1930 :    
1931 :     sub in_cluster_with {
1932 :     my($fig_or_sprout,$peg) = @_;
1933 :    
1934 :     return $fig_or_sprout->in_cluster_with($peg);
1935 :     }
1936 :    
1937 :     sub neighborhood_of_role {
1938 :     my($fig_or_sprout,$role) = @_;
1939 :    
1940 :     return $fig_or_sprout->neighborhood_of_role($role);
1941 :     }
1942 :    
1943 :     sub feature_aliasesL {
1944 :     my($fig_or_sprout,$fid) = @_;
1945 :    
1946 :     my @tmp = $fig_or_sprout->feature_aliases($fid);
1947 :     return @tmp;
1948 :     }
1949 :    
1950 :     sub feature_aliasesS {
1951 :     my($fig_or_sprout,$fid) = @_;
1952 :    
1953 :     return scalar $fig_or_sprout->feature_aliases($fid);
1954 :     }
1955 :    
1956 :     sub function_ofL {
1957 :     my($fig_or_sprout,$peg) = @_;
1958 :    
1959 :     my @tmp = $fig_or_sprout->function_of($peg);
1960 :     return @tmp;
1961 :     }
1962 :    
1963 :     sub function_ofS {
1964 :     my($fig_or_sprout,$peg) = @_;
1965 :    
1966 :     return scalar $fig_or_sprout->function_of($peg);
1967 :     }
1968 :    
1969 :     sub mapped_prot_ids {
1970 :     my($fig_or_sprout,$peg) = @_;
1971 :    
1972 :     return $fig_or_sprout->mapped_prot_ids($peg);
1973 :     }
1974 :    
1975 :     sub peg_links {
1976 :     my($fig_or_sprout,$peg) = @_;
1977 :    
1978 :     return $fig_or_sprout->peg_links($peg);
1979 :     }
1980 :    
1981 :     sub get_translation {
1982 :     my($fig_or_sprout,$prot) = @_;
1983 :    
1984 :     return $fig_or_sprout->get_translation($prot);
1985 :     }
1986 :    
1987 :     sub assign_function {
1988 :     my($fig_or_sprout,$prot,$who,$function) = @_;
1989 :    
1990 :     $fig_or_sprout->assign_function($prot,$who,$function,"");
1991 :     }
1992 :    
1993 :     sub add_annotation {
1994 :     my($fig_or_sprout,$prot,$user,$annotation) = @_;
1995 :    
1996 :     $fig_or_sprout->add_annotation($prot,$user,$annotation);
1997 :     }
1998 :    
1999 :     sub feature_annotations {
2000 :     my($fig_or_sprout,$prot) = @_;
2001 :    
2002 :     return $fig_or_sprout->feature_annotations($prot);
2003 :     }
2004 :    
2005 :     sub related_by_func_sim {
2006 :     my($fig_or_sprout,$peg,$user) = @_;
2007 :    
2008 :     return $fig_or_sprout->related_by_func_sim($peg,$user);
2009 :     }
2010 :    
2011 :     sub merged_related_annotations {
2012 :     my($fig_or_sprout,$related) = @_;
2013 :    
2014 :     return $fig_or_sprout->merged_related_annotations($related);
2015 :     }
2016 :    
2017 :     sub genus_species {
2018 :     my($fig_or_sprout,$genome) = @_;
2019 :    
2020 :     return $fig_or_sprout->genus_species($genome);
2021 :     }
2022 :    
2023 :     sub genes_in_region {
2024 :     my($fig_or_sprout,$genome,$contig,$min,$max) = @_;
2025 :    
2026 :     return $fig_or_sprout->genes_in_region($genome,$contig,$min,$max);
2027 :     }
2028 :    
2029 :     sub translate_function {
2030 :     my($fig_or_sprout,$func) = @_;
2031 :    
2032 :     return $fig_or_sprout->translate_function($func);
2033 :     }
2034 :    
2035 :     sub feature_attributes {
2036 :     my($fig_or_sprout,$peg) = @_;
2037 :    
2038 :     return $fig_or_sprout->feature_attributes($peg);
2039 :     }
2040 :    
2041 :     sub subsystems_for_peg {
2042 :     my($fig_or_sprout,$peg) = @_;
2043 :    
2044 :     return $fig_or_sprout->subsystems_for_peg($peg);
2045 :     }
2046 :    
2047 :     sub sims {
2048 :     my($fig_or_sprout,$peg,$max,$cutoff,$select,$expand) = @_;
2049 :    
2050 :     return $fig_or_sprout->sims($peg,$max,$cutoff,$select,$expand);
2051 :     }
2052 :    
2053 :     sub in_family {
2054 :     my($fig_or_sprout,$id) = @_;
2055 :    
2056 :     return $fig_or_sprout->in_family($id);
2057 :     }
2058 :    
2059 :     sub sz_family {
2060 :     my($fig_or_sprout,$family) = @_;
2061 :    
2062 :     return $fig_or_sprout->sz_family($family);
2063 :     }
2064 :    
2065 :     sub peg_to_subsystems {
2066 :     my($fig_or_sprout,$id) = @_;
2067 :    
2068 :     return $fig_or_sprout->peg_to_subsystems($id);
2069 :     }
2070 :    
2071 :     sub org_and_color_of {
2072 :     my($fig_or_sprout,$id) = @_;
2073 :    
2074 :     return $fig_or_sprout->org_and_color_of($id);
2075 :     }
2076 :    
2077 :     sub ec_to_maps {
2078 :     my($fig_or_sprout,$ec) = @_;
2079 :    
2080 :     return $fig_or_sprout->ec_to_maps($ec);
2081 :     }
2082 :    
2083 :     sub map_name {
2084 :     my($fig_or_sprout,$map) = @_;
2085 :    
2086 :     return $fig_or_sprout->map_name($map);
2087 :     }
2088 :    
2089 :     sub ec_name {
2090 :     my($fig_or_sprout,$ec) = @_;
2091 :    
2092 :     return $fig_or_sprout->ec_name($ec);
2093 :     }
2094 :    
2095 :     sub dna_seq {
2096 :     my($fig_or_sprout,$genome,$loc) = @_;
2097 :    
2098 :     return $fig_or_sprout->dna_seq($genome,$loc);
2099 :     }
2100 :    
2101 :     sub possibly_truncated {
2102 :     my($fig_or_sprout,$id) = @_;
2103 :    
2104 :     return $fig_or_sprout->possibly_truncated($id);
2105 :     }
2106 :    
2107 :     sub sort_fids_by_taxonomy {
2108 :     my($fig_or_sprout,@fids) = @_;
2109 :    
2110 :     return $fig_or_sprout->sort_fids_by_taxonomy(@fids);
2111 :     }
2112 :    
2113 :     sub in_pch_pin_with {
2114 :     my($fig_or_sprout,$peg) = @_;
2115 :    
2116 :     return $fig_or_sprout->in_pch_pin_with($peg);
2117 :     }
2118 :    
2119 :     sub crude_estimate_of_distance {
2120 :     my($fig_or_sprout,$genome1,$genome2) = @_;
2121 :    
2122 :     return $fig_or_sprout->crude_estimate_of_distance($genome1,$genome2);
2123 :     }
2124 :    
2125 :     sub maps_to_id {
2126 :     my($fig_or_sprout,$peg) = @_;
2127 :    
2128 :     return $fig_or_sprout->maps_to_id($peg);
2129 :     }
2130 :    
2131 :     sub translatable {
2132 :     my($fig_or_sprout,$peg) = @_;
2133 :    
2134 :     return $fig_or_sprout->translatable($peg);
2135 :     }
2136 :    
2137 :     sub cgi_url {
2138 :     return &FIG::plug_url($FIG_Config::cgi_url);
2139 :     }
2140 :    
2141 :    
2142 :    
2143 :     ###########################################################
2144 :    
2145 :     sub genome_of {
2146 :     my $prot_id = (@_ == 1) ? $_[0] : $_[1];
2147 :    
2148 :     if ($prot_id =~ /^fig\|(\d+\.\d+)/) { return $1; }
2149 :     return undef;
2150 :     }
2151 :    
2152 :     sub min {
2153 :     my(@x) = @_;
2154 :     my($min,$i);
2155 :    
2156 :     (@x > 0) || return undef;
2157 :     $min = $x[0];
2158 :     for ($i=1; ($i < @x); $i++)
2159 :     {
2160 :     $min = ($min > $x[$i]) ? $x[$i] : $min;
2161 :     }
2162 :     return $min;
2163 :     }
2164 :    
2165 :     sub max {
2166 :     my(@x) = @_;
2167 :     my($max,$i);
2168 :    
2169 :     (@x > 0) || return undef;
2170 :     $max = $x[0];
2171 :     for ($i=1; ($i < @x); $i++)
2172 :     {
2173 :     $max = ($max < $x[$i]) ? $x[$i] : $max;
2174 :     }
2175 :     return $max;
2176 :     }
2177 :    
2178 :    
2179 :     sub roles_of_function {
2180 :     my $func = (@_ == 1) ? $_[0] : $_[1];
2181 :    
2182 :     return (split(/\s*[\/;]\s+/,$func),($func =~ /\d+\.\d+\.\d+\.\d+/g));
2183 :     }
2184 :    
2185 :     sub ftype {
2186 :     my($feature_id) = @_;
2187 :    
2188 :     if ($feature_id =~ /^fig\|\d+\.\d+\.([^\.]+)/)
2189 :     {
2190 :     return $1;
2191 :     }
2192 :     return undef;
2193 :     }
2194 :    
2195 :     sub abbrev {
2196 :     my($genome_name) = @_;
2197 :    
2198 : overbeek 1.55 return &FIG::abbrev($genome_name);
2199 : overbeek 1.53 }
2200 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3