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

Annotation of /FigWebServices/protein.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.73 - (view) (download)

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3