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

Diff of /FigWebServices/protein.cgi

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.59, Fri Jan 14 23:06:47 2005 UTC revision 1.60, Tue Jan 18 08:16:13 2005 UTC
# Line 6  Line 6 
6      require PageBuilder;      require PageBuilder;
7  };  };
8    
9  if (!$sproutAvail)  if (!$sproutAvail) {
 {  
10      warn "Sprout library not available: $@\n";      warn "Sprout library not available: $@\n";
11  }  }
 else  
 {  
     warn "Sprout libs found\n";  
 }  
12    
13  use FIGGenDB;  use FIGGenDB;
14  use FIGjs;  use FIGjs;
# Line 24  Line 19 
19  use strict;  use strict;
20  use GenoGraphics;  use GenoGraphics;
21  use CGI;  use CGI;
22    use Tracer;
23    
24  my $cgi = new CGI;  my $cgi = new CGI;
25    
26  use Carp 'cluck';  use Carp 'cluck';
27    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    
36  if (0)  if (0) {
 {  
37      my $VAR1;      my $VAR1;
38      eval(join("",`cat /tmp/protein_parms`));      eval(join("",`cat /tmp/protein_parms`));
39      $cgi = $VAR1;      $cgi = $VAR1;
40  #   print STDERR &Dumper($cgi);  #   print STDERR &Dumper($cgi);
41  }  }
42    
43  if (0)  if (0) {
 {  
44      print $cgi->header;      print $cgi->header;
45      my @params = $cgi->param;      my @params = $cgi->param;
46      print "<pre>\n";      print "<pre>\n";
47      foreach $_ (@params)      foreach $_ (@params) {
     {  
48          print "$_\t:",join(",",$cgi->param($_)),":\n";          print "$_\t:",join(",",$cgi->param($_)),":\n";
49      }      }
50    
51      if (0)      if (0) {
52      {          if (open(TMP,">/tmp/protein_parms")) {
         if (open(TMP,">/tmp/protein_parms"))  
         {  
53              print TMP &Dumper($cgi);              print TMP &Dumper($cgi);
54              close(TMP);              close(TMP);
55          }          }
# Line 58  Line 58 
58  }  }
59    
60  my($fig_or_sprout);  my($fig_or_sprout);
61  if ($cgi->param('SPROUT'))  if ($cgi->param('SPROUT')) {
 {  
62      $fig_or_sprout = new SproutFIG($FIG_Config::sproutDB, $FIG_Config::sproutData);      $fig_or_sprout = new SproutFIG($FIG_Config::sproutDB, $FIG_Config::sproutData);
63  }  } else {
 else  
 {  
64      $fig_or_sprout = new FIG;      $fig_or_sprout = new FIG;
65  }  }
66    
# Line 72  Line 69 
69  unshift @$html, "<TITLE>The SEED Protein Page</TITLE>\n";  unshift @$html, "<TITLE>The SEED Protein Page</TITLE>\n";
70    
71  my $prot = $cgi->param('prot');  my $prot = $cgi->param('prot');
72  if (! $prot)  if (! $prot) {
 {  
73      unshift @$html, "<TITLE>The SEED: Protein Page</TITLE>\n";      unshift @$html, "<TITLE>The SEED: Protein Page</TITLE>\n";
74      push(@$html,"<h1>Sorry, you need to specify a protein</h1>\n");      push(@$html,"<h1>Sorry, you need to specify a protein</h1>\n");
75      &display_page($fig_or_sprout,$cgi,$html);      &display_page($fig_or_sprout,$cgi,$html);
76      exit;      exit;
77  }  }
78    
79  if ($prot !~ /^fig\|/)  if ($prot !~ /^fig\|/) {
 {  
80      my @poss = &by_alias($fig_or_sprout,$prot);      my @poss = &by_alias($fig_or_sprout,$prot);
81    
82      if (@poss > 0)      if (@poss > 0) {
     {  
83          $prot = $poss[0];          $prot = $poss[0];
84      }      } else {
     else  
     {  
85          unshift @$html, "<TITLE>The SEED: Protein Page</TITLE>\n";          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");          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);          &display_page($fig_or_sprout,$cgi,$html);
# Line 118  Line 110 
110  }  }
111    
112  my $request = $cgi->param("request") || "";  my $request = $cgi->param("request") || "";
   
113  my $compute_ok = eval {  my $compute_ok = eval {
114    
115    
# Line 132  Line 123 
123  elsif ($request eq "ec_to_maps")             { &show_ec_to_maps($fig_or_sprout,$cgi,$html); }  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); }  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); }  elsif ($request eq "fusions")                { &show_fusions($fig_or_sprout,$cgi,$html,$prot); }
126  else          else {
 {  
127      $html = &show_html_followed_by_initial($fig_or_sprout,$cgi,$html,$prot);      $html = &show_html_followed_by_initial($fig_or_sprout,$cgi,$html,$prot);
128  }  }
129  };  };
130    
131  if (!$compute_ok)  if (!$compute_ok) {
132  {      Trace($@);
     my $err = $@;  
     $html = { general => [] };  
     print "Content-type: text/html\n";  
     print "\n";  
   
     push(@{$html->{general}}, $cgi->h1("Error encountered during page computation:"));  
     push(@{$html->{general}}, $cgi->pre($err));  
   
133  }  }
134  &display_page($fig_or_sprout,$cgi,$html);  &display_page($fig_or_sprout,$cgi,$html);
135  exit;  exit;
# Line 161  Line 143 
143      my($url,$method,@args,$line,$name,$val);      my($url,$method,@args,$line,$name,$val);
144    
145      my $seq = &get_translation($fig_or_sprout,$prot);      my $seq = &get_translation($fig_or_sprout,$prot);
146      if (! $seq)      if (! $seq) {
     {  
147          unshift @$html, "<TITLE>The SEED: Protein Page</TITLE>\n";          unshift @$html, "<TITLE>The SEED: Protein Page</TITLE>\n";
148          push(@$html,$cgi->h1("Sorry, $prot does not have a translation"));          push(@$html,$cgi->h1("Sorry, $prot does not have a translation"));
149          return;          return;
# Line 172  Line 153 
153      my $tool = $cgi->param('tool');      my $tool = $cgi->param('tool');
154      $/ = "\n//\n";      $/ = "\n//\n";
155      my @tools = grep { $_ =~ /^$tool\n/ } `cat $FIG_Config::global/LinksToTools`;      my @tools = grep { $_ =~ /^$tool\n/ } `cat $FIG_Config::global/LinksToTools`;
156      if (@tools == 1)      if (@tools == 1) {
     {  
157          chomp $tools[0];          chomp $tools[0];
158          (undef,undef,$url,$method,@args) = split(/\n/,$tools[0]);          (undef,undef,$url,$method,@args) = split(/\n/,$tools[0]);
159          my $args = [];          my $args = [];
160          foreach $line (@args)                  foreach $line (@args) {
         {  
161              ($name,$val) = split(/\t/,$line);              ($name,$val) = split(/\t/,$line);
162              $val =~ s/FIGID/$prot/;              $val =~ s/FIGID/$prot/;
163              $val =~ s/FIGSEQ/$seq/;              $val =~ s/FIGSEQ/$seq/;
# Line 201  Line 180 
180      my $function = $cgi->param('func');      my $function = $cgi->param('func');
181      my $user     = $cgi->param('user');      my $user     = $cgi->param('user');
182    
183      if ($function && $user && $prot)      if ($function && $user && $prot) {
184      {          if ($user =~ /master:(.*)/) {
         if ($user =~ /master:(.*)/)  
         {  
185              $userR = $1;              $userR = $1;
186              &assign_function($fig_or_sprout,$prot,"master",$function,"");              &assign_function($fig_or_sprout,$prot,"master",$function,"");
187              &add_annotation($fig_or_sprout,$prot,$userR,"Set master function to\n$function\n");              &add_annotation($fig_or_sprout,$prot,$userR,"Set master function to\n$function\n");
188          }          } else {
         else  
         {  
189              &assign_function($fig_or_sprout,$prot,$user,$function,"");              &assign_function($fig_or_sprout,$prot,$user,$function,"");
190              &add_annotation($fig_or_sprout,$prot,$user,"Set function to\n$function\n");              &add_annotation($fig_or_sprout,$prot,$user,"Set function to\n$function\n");
191          }          }
# Line 231  Line 206 
206      unshift @$html, "<TITLE>The SEED: Protein Annotations</TITLE>\n";      unshift @$html, "<TITLE>The SEED: Protein Annotations</TITLE>\n";
207      my $col_hdrs = ["who","when","annotation"];      my $col_hdrs = ["who","when","annotation"];
208      my $tab = [ map { [$_->[2],$_->[1],"<pre>" . $_->[3] . "<\/pre>"] } &feature_annotations($fig_or_sprout,$prot) ];      my $tab = [ map { [$_->[2],$_->[1],"<pre>" . $_->[3] . "<\/pre>"] } &feature_annotations($fig_or_sprout,$prot) ];
209      if (@$tab > 0)      if (@$tab > 0) {
     {  
210          push(@$html,&HTML::make_table($col_hdrs,$tab,"Annotations for $prot"));          push(@$html,&HTML::make_table($col_hdrs,$tab,"Annotations for $prot"));
211      }      } else {
     else  
     {  
212          push(@$html,"<h1>No Annotations for $prot</h1>\n");          push(@$html,"<h1>No Annotations for $prot</h1>\n");
213      }      }
214  }  }
# Line 246  Line 218 
218      my($ann);      my($ann);
219    
220      unshift @$html, "<TITLE>The SEED: Protein Annotations</TITLE>\n";      unshift @$html, "<TITLE>The SEED: Protein Annotations</TITLE>\n";
221      if (&is_real_feature($fig_or_sprout,$peg))      if (&is_real_feature($fig_or_sprout,$peg)) {
     {  
222          my $col_hdrs = ["who","when","PEG","genome","annotation"];          my $col_hdrs = ["who","when","PEG","genome","annotation"];
223          my @related  = &related_by_func_sim($fig_or_sprout,$peg,$cgi->param('user'));          my @related  = &related_by_func_sim($fig_or_sprout,$peg,$cgi->param('user'));
224          push(@related,$peg);          push(@related,$peg);
# Line 259  Line 230 
230                             &genus_species($fig_or_sprout,&genome_of($ann->[0])),                             &genus_species($fig_or_sprout,&genome_of($ann->[0])),
231                             "<pre>" . $ann->[3] . "</pre>"                             "<pre>" . $ann->[3] . "</pre>"
232                             ] } @annotations];                             ] } @annotations];
233          if (@$tab > 0)                  if (@$tab > 0) {
         {  
234              push(@$html,&HTML::make_table($col_hdrs,$tab,"All Related Annotations for $peg"));              push(@$html,&HTML::make_table($col_hdrs,$tab,"All Related Annotations for $peg"));
235          }                  } else {
         else  
         {  
236              push(@$html,"<h1>No Annotations for $peg</h1>\n");              push(@$html,"<h1>No Annotations for $peg</h1>\n");
237          }          }
238      }      }
# Line 283  Line 251 
251      my $to   = $cgi->param('to');      my $to   = $cgi->param('to');
252      my @coup = grep { $_->[1] eq $to } &coupling_and_evidence($fig_or_sprout,$peg,5000,1.0e-10,4);      my @coup = grep { $_->[1] eq $to } &coupling_and_evidence($fig_or_sprout,$peg,5000,1.0e-10,4);
253    
254      if (@coup != 1)      if (@coup != 1) {
     {  
255          push(@$html,"<h1>Sorry, no evidence that $peg is coupled to $to</h1>\n");          push(@$html,"<h1>Sorry, no evidence that $peg is coupled to $to</h1>\n");
256      }      } else {
     else  
     {  
257          my $col_hdrs = ["Peg1","Organism1","Function1","Peg2","Organism2","Function2"];          my $col_hdrs = ["Peg1","Organism1","Function1","Peg2","Organism2","Function2"];
258          my $tab = [];          my $tab = [];
259          foreach $pair (@{$coup[0]->[2]})          foreach $pair (@{$coup[0]->[2]}) {
         {  
260              ($peg1,$peg2) = @$pair;              ($peg1,$peg2) = @$pair;
261              $link1 = &HTML::fid_link($cgi,$peg1);              $link1 = &HTML::fid_link($cgi,$peg1);
262              $link2 = &HTML::fid_link($cgi,$peg2);              $link2 = &HTML::fid_link($cgi,$peg2);
# Line 327  Line 291 
291      unshift @{$html->{general}}, "<TITLE>The SEED: Protein Page</TITLE>\n";      unshift @{$html->{general}}, "<TITLE>The SEED: Protein Page</TITLE>\n";
292    
293      my $gs = &org_of($fig_or_sprout,$prot);      my $gs = &org_of($fig_or_sprout,$prot);
294        Trace("got gs=$gs prot=$prot $fig_or_sprout\n") if T(2);
295      if ($prot =~ /^fig\|\d+\.\d+\.peg/)      if ($prot =~ /^fig\|\d+\.\d+\.peg/) {
296      {          if (! &is_real_feature($fig_or_sprout,$prot)) {
         if (! &is_real_feature($fig_or_sprout,$prot))  
         {  
297              push(@{$html->{general}},"<h1>Sorry, $prot is an unknown identifier</h1>\n");              push(@{$html->{general}},"<h1>Sorry, $prot is an unknown identifier</h1>\n");
298          }          } else {
         else  
         {  
299              push(@{$html->{general}},"<h1>Protein $prot: $gs</h1>\n");              push(@{$html->{general}},"<h1>Protein $prot: $gs</h1>\n");
300              &translation_piece($fig_or_sprout,$cgi,$html->{translate_status});              &translation_piece($fig_or_sprout,$cgi,$html->{translate_status});
301              &display_peg($fig_or_sprout,$cgi,$html,$prot);              &display_peg($fig_or_sprout,$cgi,$html,$prot);
302          }          }
303      }      } else {
     else  
     {  
304  #       &display_external($fig_or_sprout,$cgi,$html,$prot);  #       &display_external($fig_or_sprout,$cgi,$html,$prot);
305      }      }
306  }  }
# Line 360  Line 318 
318      my $half_sz = 5000;      my $half_sz = 5000;
319      my $fc = $cgi->param('fc');      my $fc = $cgi->param('fc');
320      my @fc_data;      my @fc_data;
321      if ($fc)      if ($fc) {
     {  
322          # RAE Added the following lines so that you can define this in the URL          # RAE Added the following lines so that you can define this in the URL
323          # but the default behavior remains unchanged. I doubt anyone will ever          # but the default behavior remains unchanged. I doubt anyone will ever
324          # see this, but I use it sometimes to see what happens          # see this, but I use it sometimes to see what happens
   
325          my ($bound,$sim_cutoff,$coupling_cutoff)=(5000, 1.0e-10, 4);          my ($bound,$sim_cutoff,$coupling_cutoff)=(5000, 1.0e-10, 4);
326          if ($cgi->param('fcbound')) {$bound=$cgi->param('fcbound')}          if ($cgi->param('fcbound')) {$bound=$cgi->param('fcbound')}
327          if ($cgi->param('fcsim')) {$sim_cutoff=$cgi->param('fcsim')}          if ($cgi->param('fcsim')) {$sim_cutoff=$cgi->param('fcsim')}
328          if ($cgi->param('fccoup')) {$coupling_cutoff=$cgi->param('fccoup')}          if ($cgi->param('fccoup')) {$coupling_cutoff=$cgi->param('fccoup')}
329    
330          @fc_data = &coupling_and_evidence($fig_or_sprout,$peg,$bound,$sim_cutoff,$coupling_cutoff);          @fc_data = &coupling_and_evidence($fig_or_sprout,$peg,$bound,$sim_cutoff,$coupling_cutoff);
331      }      } else {
     else  
     {  
332          @fc_data = ();          @fc_data = ();
333      }      }
334    
335      if ($loc = &feature_locationS($fig_or_sprout,$peg))      if ($loc = &feature_locationS($fig_or_sprout,$peg)) {
     {  
336          my($contig,$beg,$end) = &boundaries_of($fig_or_sprout,$loc);          my($contig,$beg,$end) = &boundaries_of($fig_or_sprout,$loc);
337          my $min = &max(0,&min($beg,$end) - $half_sz);          my $min = &max(0,&min($beg,$end) - $half_sz);
338          my $max = &max($beg,$end) + $half_sz;          my $max = &max($beg,$end) + $half_sz;
339            Trace("display_peg: min=$min max=$max beg=$beg end=$end") if T(2);
340          my($feat,$min,$max) = &genes_in_region($fig_or_sprout,&genome_of($peg),$contig,$min,$max);          my($feat,$min,$max) = &genes_in_region($fig_or_sprout,&genome_of($peg),$contig,$min,$max);
341            Trace("beg=$beg end=$end New min = $min, max = $max, features = " . join(", ", @{$feat})) if T(3);
342    
343          my ($beg,$end,$genes) = &print_context($fig_or_sprout,$cgi,$html->{contig_context},$peg,$feat,$min,$max);          my ($beg,$end,$genes) = &print_context($fig_or_sprout,$cgi,$html->{contig_context},$peg,$feat,$min,$max);
344            Trace("Print context returned: beg=$beg, end=$end, genes = " . join(", ", @{$genes})) if T(3);
345          &print_graphics_context($beg,$end,$genes,$html->{context_graphic});          &print_graphics_context($beg,$end,$genes,$html->{context_graphic});
     }  
346    
347      &print_assignments($fig_or_sprout,$cgi,$html->{assgn_for_equiv_prots},$peg);      &print_assignments($fig_or_sprout,$cgi,$html->{assgn_for_equiv_prots},$peg);
348      &print_kv_pairs($fig_or_sprout,$cgi,$html->{kv_pairs},$peg);      &print_kv_pairs($fig_or_sprout,$cgi,$html->{kv_pairs},$peg);
# Line 401  Line 355 
355      &print_services($fig_or_sprout,$cgi,$html->{services},$peg,$has_translation,\@fc_data);      &print_services($fig_or_sprout,$cgi,$html->{services},$peg,$has_translation,\@fc_data);
356      &print_sims_block($fig_or_sprout,$cgi,$html->{similarities},$peg,$user,$has_translation);      &print_sims_block($fig_or_sprout,$cgi,$html->{similarities},$peg,$user,$has_translation);
357    
358      if ($has_translation)          if ($has_translation) {
     {  
359          &show_tools($fig_or_sprout,$cgi,$html->{tools},$peg);          &show_tools($fig_or_sprout,$cgi,$html->{tools},$peg);
360      }      }
361  }  }
362    }
363    
364  ################# Table-Driven Show Tools  ############################  ################# Table-Driven Show Tools  ############################
365    
# Line 416  Line 370 
370                  -value => "use_protein_tool");                  -value => "use_protein_tool");
371      my $url = $cgi->self_url();      my $url = $cgi->self_url();
372    
373      if (open(TMP,"<$FIG_Config::global/LinksToTools"))      if (open(TMP,"<$FIG_Config::global/LinksToTools")) {
     {  
374          my $col_hdrs = ["Tool","Description"];          my $col_hdrs = ["Tool","Description"];
375          my $tab = [];          my $tab = [];
376    
377          $/ = "\n//\n";          $/ = "\n//\n";
378          while (defined($_ = <TMP>))          while (defined($_ = <TMP>)) {
         {  
379              my($tool,$desc) = split(/\n/,$_);              my($tool,$desc) = split(/\n/,$_);
380              push(@$tab,["<a href=\"$url\&tool=$tool\">$tool</a>",$desc]);              push(@$tab,["<a href=\"$url\&tool=$tool\">$tool</a>",$desc]);
381          }          }
# Line 443  Line 395 
395      my $user  = $cgi->param('user');      my $user  = $cgi->param('user');
396      my @tab   = map { ($sc,$neigh) = @$_;      my @tab   = map { ($sc,$neigh) = @$_;
397                        [&ev_link($cgi,$neigh,$sc),$neigh,scalar &function_ofS($fig_or_sprout,$neigh,$user)]                        [&ev_link($cgi,$neigh,$sc),$neigh,scalar &function_ofS($fig_or_sprout,$neigh,$user)]
398                      }                      } @$fc_data;
399                      @$fc_data;      if (@tab > 0) {
     if (@tab > 0)  
     {  
400          push(@$html,"<hr>\n");          push(@$html,"<hr>\n");
401          my $col_hdrs = ["Score","Peg","Function"];          my $col_hdrs = ["Score","Peg","Function"];
402          push(@$html,&HTML::make_table($col_hdrs,\@tab,"Functional Coupling"));          push(@$html,&HTML::make_table($col_hdrs,\@tab,"Functional Coupling"));
# Line 466  Line 416 
416  sub trans_function_of {  sub trans_function_of {
417      my($cgi,$fig_or_sprout,$peg,$user) = @_;      my($cgi,$fig_or_sprout,$peg,$user) = @_;
418    
419      if (wantarray())      if (wantarray()) {
     {  
420          my $x;          my $x;
421          my @funcs = &function_ofL($fig_or_sprout,$peg);          my @funcs = &function_ofL($fig_or_sprout,$peg);
422            if ($cgi->param('translate')) {
         if ($cgi->param('translate'))  
         {  
423              @funcs = map { $x = $_; $x->[1] = &translate_function($fig_or_sprout,$x->[1]); $x } @funcs;              @funcs = map { $x = $_; $x->[1] = &translate_function($fig_or_sprout,$x->[1]); $x } @funcs;
424          }          }
425          return @funcs;          return @funcs;
426      }      } else {
     else  
     {  
427          my $func = &function_ofS($fig_or_sprout,$peg,$user);          my $func = &function_ofS($fig_or_sprout,$peg,$user);
428          if ($cgi->param('translate'))          if ($cgi->param('translate')) {
         {  
429              $func = &translate_function($fig_or_sprout,$func);              $func = &translate_function($fig_or_sprout,$func);
430          }          }
431          return $func;          return $func;
# Line 495  Line 439 
439      my($fig_or_sprout,$cgi,$html,$peg,$user,$has_translation) = @_;      my($fig_or_sprout,$cgi,$html,$peg,$user,$has_translation) = @_;
440    
441      my $sims = $cgi->param('sims');      my $sims = $cgi->param('sims');
442      if ((! $sims) && $has_translation)      if ((! $sims) && $has_translation) {
     {  
443          my $max_expand = $cgi->param('max_expand') ||  5;          my $max_expand = $cgi->param('max_expand') ||  5;
444          my $maxN       = $cgi->param('maxN')       || 50;   #  Default 50, not 5 (GJO)          my $maxN       = $cgi->param('maxN')       || 50;   #  Default 50, not 5 (GJO)
445          my $maxP       = $cgi->param('maxP')       ||  1.0e-5;          my $maxP       = $cgi->param('maxP')       ||  1.0e-5;
# Line 506  Line 449 
449          my $hide_alias = $cgi->param('hide_alias') ||  0;          my $hide_alias = $cgi->param('hide_alias') ||  0;
450    
451          push( @$html, $cgi->start_form(-action => "protein.cgi#Similarities"));          push( @$html, $cgi->start_form(-action => "protein.cgi#Similarities"));
452          if ($cgi->param('translate'))          if ($cgi->param('translate')) {
         {  
453              push(@$html,$cgi->hidden(-name => 'translate', -value => 1));              push(@$html,$cgi->hidden(-name => 'translate', -value => 1));
454          }          }
455          my $sprout = $cgi->param('SPROUT') ? 1 : "";          my $sprout = $cgi->param('SPROUT') ? 1 : "";
# Line 526  Line 468 
468                        " Hide aliases: ", $cgi->checkbox(-name => 'hide_alias', -value => 1, -checked => $hide_alias, -override => 1, -label => ""),                        " Hide aliases: ", $cgi->checkbox(-name => 'hide_alias', -value => 1, -checked => $hide_alias, -override => 1, -label => ""),
469                        $cgi->end_form                        $cgi->end_form
470              );              );
471      }      } elsif ($sims) {
     elsif ($sims)  
     {  
472          &print_similarities($fig_or_sprout,$cgi,$html,$peg);          &print_similarities($fig_or_sprout,$cgi,$html,$peg);
473      }      }
474  }  }
# Line 554  Line 494 
494      $link =~ s/protein.cgi/fid_checked.cgi/;      $link =~ s/protein.cgi/fid_checked.cgi/;
495      my $sprout = $cgi->param('SPROUT') ? 1 : "";      my $sprout = $cgi->param('SPROUT') ? 1 : "";
496      my $user = $cgi->param('user');      my $user = $cgi->param('user');
497      if (! $user)      if (! $user) {
     {  
498          $user = "";          $user = "";
499      }      } else {
     else  
     {  
500          $link = $link . "?SPROUT=$sprout&fid=$prot&user=$user&checked=$prot&assign/annotate=assign/annotate";          $link = $link . "?SPROUT=$sprout&fid=$prot&user=$user&checked=$prot&assign/annotate=assign/annotate";
501          push(@$html,"<br><a href=$link target=checked_window>To Make an Annotation</a>\n");          push(@$html,"<br><a href=$link target=checked_window>To Make an Annotation</a>\n");
502      }      }
503    
504      my $fc = $cgi->param('fc');      my $fc = $cgi->param('fc');
505      if ((! $fc) && (&feature_locationS($fig_or_sprout,$peg)))      if ((! $fc) && (&feature_locationS($fig_or_sprout,$peg))) {
     {  
506          my $link = $cgi->self_url() . "&fc=1";          my $link = $cgi->self_url() . "&fc=1";
507          push(@$html,"<br><a href=$link>To Get Detailed Functional Coupling Data</a>\n");          push(@$html,"<br><a href=$link>To Get Detailed Functional Coupling Data</a>\n");
508      }      } elsif ($fc) {
     elsif ($fc)  
     {  
509          &print_fc($fig_or_sprout,$cgi,$html,$peg,$fc_data);          &print_fc($fig_or_sprout,$cgi,$html,$peg,$fc_data);
510      }      }
511    
# Line 582  Line 516 
516      my $link = &cgi_url . "/homologs_in_clusters.cgi?SPROUT=$sprout&prot=$peg&user=$user\n";      my $link = &cgi_url . "/homologs_in_clusters.cgi?SPROUT=$sprout&prot=$peg&user=$user\n";
517      push(@$html,"<br><a href=$link>To Find Homologs in Clusters</a>\n");      push(@$html,"<br><a href=$link>To Find Homologs in Clusters</a>\n");
518    
519      if ((! $cgi->param('compare_region')) && $has_translation)      if ((! $cgi->param('compare_region')) && $has_translation) {
     {  
520          my $link = $cgi->self_url() . "&compare_region=1";          my $link = $cgi->self_url() . "&compare_region=1";
521          push(@$html,"<br><a href=$link>To Compare Region</a>\n");          push(@$html,"<br><a href=$link>To Compare Region</a>\n");
522      }      } elsif ($cgi->param('compare_region')) {
     elsif ($cgi->param('compare_region'))  
     {  
523          &print_compared_regions($fig_or_sprout,$cgi,$html,$peg);          &print_compared_regions($fig_or_sprout,$cgi,$html,$peg);
524      }      }
525  }  }
# Line 601  Line 532 
532      my @funcs    = map { [$peg,@$_] } &trans_function_of($cgi,$fig_or_sprout,$peg);      my @funcs    = map { [$peg,@$_] } &trans_function_of($cgi,$fig_or_sprout,$peg);
533    
534      for ($i=0; ($i < @funcs) && ($funcs[$i]->[1] ne "master"); $i++) {}      for ($i=0; ($i < @funcs) && ($funcs[$i]->[1] ne "master"); $i++) {}
535      if ($i < @funcs)      if ($i < @funcs) {
     {  
536          $master_func = $funcs[$i]->[2];          $master_func = $funcs[$i]->[2];
537      }      } else {
     else  
     {  
538          $master_func = "";          $master_func = "";
539      }      }
540    
541      for ($i=0; ($i < @funcs) && ($funcs[$i]->[1] ne $user); $i++) {}      for ($i=0; ($i < @funcs) && ($funcs[$i]->[1] ne $user); $i++) {}
542      if ($i < @funcs)      if ($i < @funcs) {
     {  
543          $user_func = $funcs[$i]->[2];          $user_func = $funcs[$i]->[2];
544      }      } else {
     else  
     {  
545          $user_func = $master_func;          $user_func = $master_func;
546      }      }
547      push(@$html,$cgi->h2("Current Assignment: $peg: $user_func"));      push(@$html,$cgi->h2("Current Assignment: $peg: $user_func"));
548      my @maps_to  = grep { $_ ne $peg } map { $_->[0] } &mapped_prot_ids($fig_or_sprout,$peg);      my @maps_to  = grep { $_ ne $peg } map { $_->[0] } &mapped_prot_ids($fig_or_sprout,$peg);
549      @funcs = ();      @funcs = ();
550      foreach $id (@maps_to)      foreach $id (@maps_to) {
551      {          if (($id ne $peg) && (@tmp = &trans_function_of($cgi,$fig_or_sprout,$id)) && (@tmp > 0)) {
         if (($id ne $peg) && (@tmp = &trans_function_of($cgi,$fig_or_sprout,$id)) && (@tmp > 0))  
         {  
552              push(@funcs, map { $x = $_; [$id,@$_] } @tmp);              push(@funcs, map { $x = $_; [$id,@$_] } @tmp);
553          }          }
554      }      }
555      @funcs = map { ($_->[1] eq "master") ? [$_->[0],"",$_->[2]] : $_ } @funcs;      @funcs = map { ($_->[1] eq "master") ? [$_->[0],"",$_->[2]] : $_ } @funcs;
556      push(@$html,"<hr>\n");      push(@$html,"<hr>\n");
557    
558      if ((@funcs == 0) && (! $user_func))      if ((@funcs == 0) && (! $user_func)) {
     {  
559          push(@$html,$cgi->h1("No function has been assigned"));          push(@$html,$cgi->h1("No function has been assigned"));
560      }      }
561    
562      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 ];      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 ];
563      if (@$tab > 0)      if (@$tab > 0) {
     {  
564          my $col_hdrs = ["Id","Organism","Who","ASSIGN","Assignment"];          my $col_hdrs = ["Id","Organism","Who","ASSIGN","Assignment"];
565          my $title    = "Assignments for Essentially Identical Proteins";          my $title    = "Assignments for Essentially Identical Proteins";
566          push(@$html,&HTML::make_table($col_hdrs,$tab,$title));          push(@$html,&HTML::make_table($col_hdrs,$tab,$title));
# Line 650  Line 571 
571      my($fig_or_sprout,$cgi,$html,$peg) = @_;      my($fig_or_sprout,$cgi,$html,$peg) = @_;
572    
573      my @attr = &feature_attributes($fig_or_sprout,$peg);      my @attr = &feature_attributes($fig_or_sprout,$peg);
574      if (@attr > 0)      if (@attr > 0) {
     {  
575          my $tab = [];          my $tab = [];
576          foreach $_ (@attr)          foreach $_ (@attr) {
         {  
577              my($tag,$val,$url) = @$_;              my($tag,$val,$url) = @$_;
578              push(@$tab,[$tag,"<a href=\"$url\">$val</a>"]);              push(@$tab,[$tag,"<a href=\"$url\">$val</a>"]);
579          }          }
# Line 669  Line 588 
588      # Show the subsystems in which this protein participates.      # Show the subsystems in which this protein participates.
589      #      #
590    
591      if (my @subsystems = &subsystems_for_peg($fig_or_sprout,$peg))      if (my @subsystems = &subsystems_for_peg($fig_or_sprout,$peg)) {
     {  
592          push(@$html,          push(@$html,
593               $cgi->h2("Subsystems in which this peg is present"));               $cgi->h2("Subsystems in which this peg is present"));
594    
# Line 681  Line 599 
599    
600          my $sprout = $cgi->param('SPROUT') ? 1 : "";          my $sprout = $cgi->param('SPROUT') ? 1 : "";
601    
602          for my $ent (@subsystems)          for my $ent (@subsystems) {
         {  
603              my($sub, $role) = @$ent;              my($sub, $role) = @$ent;
604              my $url = $cgi->a({href => "subsys.cgi?SPROUT=$sprout&user=$user&ssa_name=$sub&request=show_ssa"}, $sub);              my $url = $cgi->a({href => "subsys.cgi?SPROUT=$sprout&user=$user&ssa_name=$sub&request=show_ssa"}, $sub);
605              push(@table, [$url, $role]);              push(@table, [$url, $role]);
# Line 694  Line 611 
611  sub print_links {  sub print_links {
612      my($fig_or_sprout,$cgi,$html,$peg) = @_;      my($fig_or_sprout,$cgi,$html,$peg) = @_;
613    
614      my @links = &peg_links($fig_or_sprout,$peg)      my @links = &peg_links($fig_or_sprout,$peg);
615  ;      if (@links > 0) {
     if (@links > 0)  
     {  
616          my $col_hdrs = [1,2,3,4,5];          my $col_hdrs = [1,2,3,4,5];
617          my $title    = "Links to Related Entries in Other Sites";          my $title    = "Links to Related Entries in Other Sites";
618          my $tab = [];          my $tab = [];
619          my ($n,$i);          my ($n,$i);
620          for ($i=0; ($i < @links); $i += 5)          for ($i=0; ($i < @links); $i += 5) {
         {  
621              $n = (($i + (5-1)) < @links) ? $i+(5-1) : $i+(@links - $i);              $n = (($i + (5-1)) < @links) ? $i+(5-1) : $i+(@links - $i);
622              push(@$tab,[@links[$i..$n]]);              push(@$tab,[@links[$i..$n]]);
623          }          }
624          push(@$html,&HTML::make_table($col_hdrs,$tab,$title));          push(@$html,&HTML::make_table($col_hdrs,$tab,$title));
625      }      }
626    
627      if (! $cgi->param('SPROUT'))      if (! $cgi->param('SPROUT')) {
     {  
628          my $url = &cgi_url . "/add_links.cgi?peg=$peg";          my $url = &cgi_url . "/add_links.cgi?peg=$peg";
629          push(@$html,"<a href=$url>To Add New Links to this Gene</a>\n");          push(@$html,"<a href=$url>To Add New Links to this Gene</a>\n");
630      }      }
# Line 765  Line 678 
678    
679      push(@$html, $cgi->start_form(-action => "protein.cgi#Similarities"));      push(@$html, $cgi->start_form(-action => "protein.cgi#Similarities"));
680    
681      if ($cgi->param('translate'))      if ($cgi->param('translate')) {
     {  
682          push(@$html,$cgi->hidden(-name => 'translate', -value => 1));          push(@$html,$cgi->hidden(-name => 'translate', -value => 1));
683      }      }
684    
# Line 795  Line 707 
707      my $select = $just_fig ? "fig" : "all";      my $select = $just_fig ? "fig" : "all";
708      my @sims = &sims($fig_or_sprout, $peg, $maxN, $maxP, $select, $max_expand );      my @sims = &sims($fig_or_sprout, $peg, $maxN, $maxP, $select, $max_expand );
709    
710      if (@sims)      if (@sims) {
     {  
711          my @from = $cgi->radio_group(-name => 'from',          my @from = $cgi->radio_group(-name => 'from',
712                                       -nolabels => 1,                                       -nolabels => 1,
713                                       -override => 1,                                       -override => 1,
# Line 820  Line 731 
731                             $cgi->submit('show regions')                             $cgi->submit('show regions')
732              );              );
733    
734          if ($user)          if ($user) {
735          {   my $help_url = "Html/help_for_assignments_and_rules.html";              my $help_url = "Html/help_for_assignments_and_rules.html";
736              push ( @$html, $cgi->br, $cgi->br,              push ( @$html, $cgi->br, $cgi->br,
737                             "<a href=$help_url>Help on Assignments, Rules, and Checkboxes</a>",                             "<a href=$help_url>Help on Assignments, Rules, and Checkboxes</a>",
738                             $cgi->br, $cgi->br,                             $cgi->br, $cgi->br,
739                             $cgi->submit('assign/annotate')                             $cgi->submit('assign/annotate')
740                   );                   );
741    
742              if ($cgi->param('translate'))              if ($cgi->param('translate')) {
             {  
743                  push( @$html, $cgi->submit('add rules'),                  push( @$html, $cgi->submit('add rules'),
744                                $cgi->submit('check rules'),                                $cgi->submit('check rules'),
745                                $cgi->br                                $cgi->br
# Line 848  Line 758 
758    
759          my $col_hdrs;          my $col_hdrs;
760          my $color_help = "(<A href=\"Html/similarity_region_colors.html\">colors explained</A>)";          my $color_help = "(<A href=\"Html/similarity_region_colors.html\">colors explained</A>)";
761          if ($user && $cgi->param('translate'))          if ($user && $cgi->param('translate')) {
         {  
762              push( @$html, " ASSIGN to/Translate from/SELECT current PEG", $cgi->br,              push( @$html, " ASSIGN to/Translate from/SELECT current PEG", $cgi->br,
763                            "ASSIGN/annotate with form: ", shift @from, $cgi->br,                            "ASSIGN/annotate with form: ", shift @from, $cgi->br,
764                            "ASSIGN from/Translate to current PEG: ", shift @from                            "ASSIGN from/Translate to current PEG: ", shift @from
# Line 867  Line 776 
776                            "Organism",                            "Organism",
777                            ! $hide_alias ? "Aliases" : ()                            ! $hide_alias ? "Aliases" : ()
778                          ];                          ];
779          }          } elsif ($user) {
         elsif ($user)  
         {  
780              push( @$html, " ASSIGN to/SELECT current PEG", $cgi->br,              push( @$html, " ASSIGN to/SELECT current PEG", $cgi->br,
781                            "ASSIGN/annotate with form: ", shift @from, $cgi->br,                            "ASSIGN/annotate with form: ", shift @from, $cgi->br,
782                            "ASSIGN from current PEG: ", shift @from                            "ASSIGN from current PEG: ", shift @from
# Line 887  Line 794 
794                            "Organism",                            "Organism",
795                            ! $hide_alias ? "Aliases" : ()                            ! $hide_alias ? "Aliases" : ()
796                          ];                          ];
797          }          } else {
         else  
         {  
798              push(@$html, " SELECT current PEG", $cgi->br );              push(@$html, " SELECT current PEG", $cgi->br );
799              $col_hdrs = [ "SELECT",              $col_hdrs = [ "SELECT",
800                            $expand_groups ? "family" : (),                            $expand_groups ? "family" : (),
# Line 927  Line 832 
832    
833          my $alia = ! $hide_alias;          my $alia = ! $hide_alias;
834          my $sim;          my $sim;
835          foreach $sim ( @sims )          foreach $sim ( @sims ) {
         {  
836              my $id2  = $sim->id2;              my $id2  = $sim->id2;
837              if ((! $show_env) && ($id2 =~ /^fig\|99999/))              if ((! $show_env) && ($id2 =~ /^fig\|99999/)) {
             {  
838                  shift @from;                  shift @from;
839                  next;                  next;
840              }              }
# Line 939  Line 842 
842                         qq(<input type=checkbox name=checked value="$id2">) : "";                         qq(<input type=checkbox name=checked value="$id2">) : "";
843    
844              my( $family, $sz, $funcF, $fam_link );              my( $family, $sz, $funcF, $fam_link );
845              if ($expand_groups && ($id2 =~ /^fig\|/) && ($family = &in_family($fig_or_sprout,$id2)))              if ($expand_groups && ($id2 =~ /^fig\|/) && ($family = &in_family($fig_or_sprout,$id2))) {
             {  
846                  $sz       = &sz_family($fig_or_sprout,$family);                  $sz       = &sz_family($fig_or_sprout,$family);
847                  $funcF    = html_enc( &family_function($fig_or_sprout,$family) );                  $funcF    = html_enc( &family_function($fig_or_sprout,$family) );
848                  $fam_link = scalar &HTML::family_link( $family, $user );                  $fam_link = scalar &HTML::family_link( $family, $user );
849              }              } else {
             else  
             {  
850                  $family = $sz = $funcF = $fam_link = "";                  $family = $sz = $funcF = $fam_link = "";
851              }              }
852    
# Line 955  Line 855 
855    
856              my @in_sub  = &peg_to_subsystems($fig_or_sprout,$id2);              my @in_sub  = &peg_to_subsystems($fig_or_sprout,$id2);
857              my $in_sub;              my $in_sub;
858              if (@in_sub > 0)              if (@in_sub > 0) {
             {  
859                  $in_sub = @in_sub;                  $in_sub = @in_sub;
860              }              } else {
             else  
             {  
861                  $in_sub = "";                  $in_sub = "";
862              }              }
863    
# Line 1130  Line 1027 
1027      my $peg_function = &trans_function_of($cgi,$fig_or_sprout,$peg,$user);      my $peg_function = &trans_function_of($cgi,$fig_or_sprout,$peg,$user);
1028    
1029      my($role,$role1,%related_roles);      my($role,$role1,%related_roles);
1030      foreach $role (&roles_of_function($peg_function))      foreach $role (&roles_of_function($peg_function)) {
1031      {          foreach $role1 (&neighborhood_of_role($fig_or_sprout,$role)) {
         foreach $role1 (&neighborhood_of_role($fig_or_sprout,$role))  
         {  
1032              $related_roles{$role1} = 1;              $related_roles{$role1} = 1;
1033          }          }
1034      }      }
1035        foreach $fid1 (@$feat) {
     foreach $fid1 (@$feat)  
     {  
1036          $fc = $in_cluster{$fid1} ? &pin_link($cgi,$fid1) : "";          $fc = $in_cluster{$fid1} ? &pin_link($cgi,$fid1) : "";
1037    
1038          my $aliases = join( ', ', &feature_aliasesL($fig_or_sprout,$fid1) );          my $aliases = join( ', ', &feature_aliasesL($fig_or_sprout,$fid1) );
1039          ($contig1,$beg1,$end1) = &boundaries_of($fig_or_sprout,&feature_locationS($fig_or_sprout,$fid1));;          ($contig1,$beg1,$end1) = &boundaries_of($fig_or_sprout,&feature_locationS($fig_or_sprout,$fid1));;
1040          $strand = ($beg1 < $end1) ? "+" : "-";          $strand = ($beg1 < $end1) ? "+" : "-";
# Line 1153  Line 1047 
1047          }          }
1048          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 : '');          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 : '');
1049    
   
1050          if     ($fid1 eq $peg)    { $color = "green" }          if     ($fid1 eq $peg)    { $color = "green" }
1051          elsif  ($fc)              { $color = "blue" }          elsif  ($fc)              { $color = "blue" }
1052          else                      { $color = "red" }          else                      { $color = "red" }
1053    
1054          if ($fid1 =~ /peg\.(\d+)$/)          if ($fid1 =~ /peg\.(\d+)$/) {
         {  
1055              $n = $1;              $n = $1;
1056              $link = $cgi->url() . "?prot=$fid1&user=$user";              $link = $cgi->url() . "?prot=$fid1&user=$user";
1057          }          } elsif ($fid1 =~ /\.([a-z]+)\.\d+$/) {
         elsif ($fid1 =~ /\.([a-z]+)\.\d+$/)  
         {  
1058              $n = uc $1;              $n = uc $1;
1059              $link = "";              $link = "";
1060          }          } else {
         else  
         {  
1061              $n ="";              $n ="";
1062              $link = "";              $link = "";
1063          }          }
1064    
1065          push(@$genes,[&min($beg1,$end1),&max($beg1,$end1),($strand eq "+") ? "rightArrow" : "leftArrow", $color,$n,$link,$info]);          push(@$genes,[&min($beg1,$end1),&max($beg1,$end1),($strand eq "+") ? "rightArrow" : "leftArrow", $color,$n,$link,$info]);
1066          if ($max_so_far)          if ($max_so_far) {
         {  
1067              $gap = (&min($beg1,$end1) - $max_so_far) - 1;              $gap = (&min($beg1,$end1) - $max_so_far) - 1;
1068          }          } else {
         else  
         {  
1069              $gap = "";              $gap = "";
1070          }          }
1071          $max_so_far = &max($beg1,$end1);          $max_so_far = &max($beg1,$end1);
1072    
1073    
1074          $in_neighborhood = "";          $in_neighborhood = "";
1075            if (&ftype($fid1) eq "peg") {
         if (&ftype($fid1) eq "peg")  
         {  
1076              $comment = &trans_function_of($cgi,$fig_or_sprout,$fid1,$user);              $comment = &trans_function_of($cgi,$fig_or_sprout,$fid1,$user);
1077              foreach $role (&roles_of_function($comment))              foreach $role (&roles_of_function($comment)) {
1078              {                  if ($related_roles{$role}) {
                 if ($related_roles{$role})  
                 {  
1079                      $in_neighborhood = "*";                      $in_neighborhood = "*";
1080                  }                  }
1081              }              }
1082          }          } else {
         else  
         {  
1083              $comment = "";              $comment = "";
1084          }          }
1085          $comment = &set_map_links($fig_or_sprout,&genome_of($fid1),$comment);          $comment = &set_map_links($fig_or_sprout,&genome_of($fid1),$comment);
1086          if ($fid1 eq $peg)          if ($fid1 eq $peg) {
         {  
1087              $comment = "\@bgcolor=\"#00FF00\":$comment";              $comment = "\@bgcolor=\"#00FF00\":$comment";
1088          }          }
1089          $sz = abs($end1-$beg1)+1;          $sz = abs($end1-$beg1)+1;
# Line 1239  Line 1117 
1117      my($cgi,$func,$existing_func) = @_;      my($cgi,$func,$existing_func) = @_;
1118      my($assign_url,$assign_link);      my($assign_url,$assign_link);
1119    
1120      if ($func && ((! $existing_func) || ($existing_func ne $func)))      if ($func && ((! $existing_func) || ($existing_func ne $func))) {
     {  
1121          $cgi->delete('request');          $cgi->delete('request');
1122          $assign_url  = $cgi->self_url() . "&request=fast_assign&func=$func";  ## must encode          $assign_url  = $cgi->self_url() . "&request=fast_assign&func=$func";  ## must encode
1123          $assign_link = "<a href=\"$assign_url\">&nbsp;<=&nbsp;</a>";          $assign_link = "<a href=\"$assign_url\">&nbsp;<=&nbsp;</a>";
1124      }      } else {
     else  
     {  
1125          $assign_link = "";          $assign_link = "";
1126      }      }
1127      return $assign_link;      return $assign_link;
# Line 1266  Line 1141 
1141  sub set_map_links {  sub set_map_links {
1142      my($fig_or_sprout,$org,$func) = @_;      my($fig_or_sprout,$org,$func) = @_;
1143    
1144      if ($func =~ /^(.*)(\d+\.\d+\.\d+\.\d+)(.*)$/)      if ($func =~ /^(.*)(\d+\.\d+\.\d+\.\d+)(.*)$/) {
     {  
1145          my $before = $1;          my $before = $1;
1146          my $ec     = $2;          my $ec     = $2;
1147          my $after  = $3;          my $after  = $3;
# Line 1280  Line 1154 
1154      my($fig_or_sprout,$org,$ec) = @_;      my($fig_or_sprout,$org,$ec) = @_;
1155    
1156      my @maps = &ec_to_maps($fig_or_sprout,$ec);      my @maps = &ec_to_maps($fig_or_sprout,$ec);
1157      if (@maps > 0)      if (@maps > 0) {
     {  
1158          $cgi->delete('request');          $cgi->delete('request');
1159          my $url  = $cgi->self_url() . "&request=ec_to_maps&ec=$ec&org=$org";          my $url  = $cgi->self_url() . "&request=ec_to_maps&ec=$ec&org=$org";
1160          my $link = "<a href=\"$url\">$ec</a>";          my $link = "<a href=\"$url\">$ec</a>";
# Line 1294  Line 1167 
1167      my($fig_or_sprout,$cgi,$html,$ec) = @_;      my($fig_or_sprout,$cgi,$html,$ec) = @_;
1168    
1169      my $ec = $cgi->param('ec');      my $ec = $cgi->param('ec');
1170      if (! $ec)      if (! $ec) {
     {  
1171          push(@$html,$cgi->h1("Missing EC number"));          push(@$html,$cgi->h1("Missing EC number"));
1172          return;          return;
1173      }      }
1174    
1175      my @maps = &ec_to_maps($fig_or_sprout,$ec);      my @maps = &ec_to_maps($fig_or_sprout,$ec);
1176      if (@maps > 0)      if (@maps > 0) {
     {  
1177          my $col_hdrs = ["map","metabolic topic"];          my $col_hdrs = ["map","metabolic topic"];
1178          my $map;          my $map;
1179          my $tab      = [map { $map = $_; [&map_link($cgi,$map),&map_name($fig_or_sprout,$map)] } @maps];          my $tab      = [map { $map = $_; [&map_link($cgi,$map),&map_name($fig_or_sprout,$map)] } @maps];
# Line 1323  Line 1194 
1194      my($fig_or_sprout,$cgi,$html) = @_;      my($fig_or_sprout,$cgi,$html) = @_;
1195    
1196      my $map = $cgi->param('map');      my $map = $cgi->param('map');
1197      if (! $map)      if (! $map) {
     {  
1198          push(@$html,$cgi->h1("Missing Map"));          push(@$html,$cgi->h1("Missing Map"));
1199          return;          return;
1200      }      }
1201    
1202      my $org = $cgi->param('org');      my $org = $cgi->param('org');
1203      if (! $org)      if (! $org) {
     {  
1204          push(@$html,$cgi->h1("Missing Org Parameter"));          push(@$html,$cgi->h1("Missing Org Parameter"));
1205          return;          return;
1206      }      }
# Line 1350  Line 1219 
1219      my($seq,$func,$i);      my($seq,$func,$i);
1220    
1221      unshift @$html, "<TITLE>The SEED: Protein Sequence</TITLE>\n";      unshift @$html, "<TITLE>The SEED: Protein Sequence</TITLE>\n";
1222      if ($seq = &get_translation($fig_or_sprout,$prot))      if ($seq = &get_translation($fig_or_sprout,$prot)) {
     {  
1223          $func = &function_ofS($fig_or_sprout,$prot,$cgi->param('user'));          $func = &function_ofS($fig_or_sprout,$prot,$cgi->param('user'));
1224          push(@$html,$cgi->pre,">$prot $func\n");          push(@$html,$cgi->pre,">$prot $func\n");
1225          for ($i=0; ($i < length($seq)); $i += 60)          for ($i=0; ($i < length($seq)); $i += 60) {
1226          {              if ($i > (length($seq) - 60)) {
             if ($i > (length($seq) - 60))  
             {  
1227                  push(@$html,substr($seq,$i) . "\n");                  push(@$html,substr($seq,$i) . "\n");
1228              }              } else {
             else  
             {  
1229                  push(@$html,substr($seq,$i,60) . "\n");                  push(@$html,substr($seq,$i,60) . "\n");
1230              }              }
1231          }          }
1232          push(@$html,$cgi->end_pre);          push(@$html,$cgi->end_pre);
1233      }      } else {
     else  
     {  
1234          push(@$html,$cgi->h1("No translation available for $prot"));          push(@$html,$cgi->h1("No translation available for $prot"));
1235      }      }
1236  }  }
# Line 1378  Line 1240 
1240      my($seq,$func,$i);      my($seq,$func,$i);
1241    
1242      unshift @$html, "<TITLE>The SEED: Nucleotide Sequence</TITLE>\n";      unshift @$html, "<TITLE>The SEED: Nucleotide Sequence</TITLE>\n";
1243      if ($seq = &dna_seq($fig_or_sprout,&genome_of($fid),&feature_locationS($fig_or_sprout,$fid)))      if ($seq = &dna_seq($fig_or_sprout,&genome_of($fid),&feature_locationS($fig_or_sprout,$fid))) {
     {  
1244          $func = &function_ofS($fig_or_sprout,$prot,$cgi->param('user'));          $func = &function_ofS($fig_or_sprout,$prot,$cgi->param('user'));
1245          push(@$html,$cgi->pre,">$fid $func\n");          push(@$html,$cgi->pre,">$fid $func\n");
1246          for ($i=0; ($i < length($seq)); $i += 60)          for ($i=0; ($i < length($seq)); $i += 60) {
1247          {              if ($i > (length($seq) - 60)) {
             if ($i > (length($seq) - 60))  
             {  
1248                  push(@$html,substr($seq,$i) . "\n");                  push(@$html,substr($seq,$i) . "\n");
1249              }              } else {
             else  
             {  
1250                  push(@$html,substr($seq,$i,60) . "\n");                  push(@$html,substr($seq,$i,60) . "\n");
1251              }              }
1252          }          }
1253          push(@$html,$cgi->end_pre);          push(@$html,$cgi->end_pre);
1254      }      } else {
     else  
     {  
1255          push(@$html,$cgi->h1("No DNA sequence available for $fid"));          push(@$html,$cgi->h1("No DNA sequence available for $fid"));
1256      }      }
1257  }  }
# Line 1427  Line 1282 
1282    
1283      my @closest_pegs = &closest_pegs($fig_or_sprout,$peg,$num_close);      my @closest_pegs = &closest_pegs($fig_or_sprout,$peg,$num_close);
1284    
1285      if (@closest_pegs > 0)      if (@closest_pegs > 0) {
1286      {          if (&possibly_truncated($fig_or_sprout,$peg)) {
         if (&possibly_truncated($fig_or_sprout,$peg))  
         {  
1287              push(@closest_pegs,&possible_extensions($peg,\@closest_pegs));              push(@closest_pegs,&possible_extensions($peg,\@closest_pegs));
1288          }          }
1289          @closest_pegs = &sort_fids_by_taxonomy($fig_or_sprout,@closest_pegs);          @closest_pegs = &sort_fids_by_taxonomy($fig_or_sprout,@closest_pegs);
# Line 1445  Line 1298 
1298          my @parm_reset_form = ($cgi->hr);          my @parm_reset_form = ($cgi->hr);
1299          push(@parm_reset_form,$cgi->start_form(-action => &cgi_url . "/protein.cgi" ));          push(@parm_reset_form,$cgi->start_form(-action => &cgi_url . "/protein.cgi" ));
1300          my $param;          my $param;
1301          foreach $param ($cgi->param())          foreach $param ($cgi->param()) {
         {  
1302              next if (($param eq "sz_region") || ($param eq "num_close"));              next if (($param eq "sz_region") || ($param eq "num_close"));
1303              push(@parm_reset_form,$cgi->hidden(-name => $param, -value => $cgi->param($param)));              push(@parm_reset_form,$cgi->hidden(-name => $param, -value => $cgi->param($param)));
1304          }          }
# Line 1480  Line 1332 
1332          my($gene,$n,%how_many,$val,@vals,$x);          my($gene,$n,%how_many,$val,@vals,$x);
1333          my($i,$map);          my($i,$map);
1334          @vals = ();          @vals = ();
1335          for ($i=(@$gg - 1); ($i >= 0); $i--)          for ($i=(@$gg - 1); ($i >= 0); $i--) {
         {  
1336              my @vals1 = ();              my @vals1 = ();
1337              $map = $gg->[$i];              $map = $gg->[$i];
1338              my $found = 0;              my $found = 0;
1339              my $got_red = 0;              my $got_red = 0;
1340              undef %how_many;              undef %how_many;
1341              foreach $gene (@{$map->[3]})              foreach $gene (@{$map->[3]}) {
1342              {                  if (($x = $gene->[3]) ne "grey") {
                 if (($x = $gene->[3]) ne "grey")  
                 {  
1343                      $n = $gene->[4];                      $n = $gene->[4];
1344                      if ($n == 1) { $got_red = 1 }                      if ($n == 1) { $got_red = 1 }
1345                      $how_many{$n}++;                      $how_many{$n}++;
# Line 1501  Line 1350 
1350                  }                  }
1351              }              }
1352    
1353              if (! $got_red)              if (! $got_red) {
             {  
1354                  splice(@$gg,$i,1);                  splice(@$gg,$i,1);
1355              }              } else {
             else  
             {  
1356                  push(@vals,@vals1);                  push(@vals,@vals1);
1357              }              }
1358          }          }
1359    
1360          if (@$gg == 0)          if (@$gg == 0) {
         {  
1361              push(@$html,$cgi->h1("Sorry, no pins worked out"));              push(@$html,$cgi->h1("Sorry, no pins worked out"));
1362          }          } else {
         else  
         {  
1363              push(@commentary_form,$cgi->hidden(-name => "show", -value => [@vals]));              push(@commentary_form,$cgi->hidden(-name => "show", -value => [@vals]));
1364              push(@commentary_form,$cgi->submit('commentary'));              push(@commentary_form,$cgi->submit('commentary'));
1365              push(@commentary_form,$cgi->end_form());              push(@commentary_form,$cgi->end_form());
# Line 1544  Line 1387 
1387          map { $peg2 = $_; $d = &crude_estimate_of_distance($fig_or_sprout,$g1,&genome_of($peg2)); [$d,$peg2] }          map { $peg2 = $_; $d = &crude_estimate_of_distance($fig_or_sprout,$g1,&genome_of($peg2)); [$d,$peg2] }
1388          @pinned_to;          @pinned_to;
1389    
1390      for ($i=0; ($i < @pinned_to) && ($i < $n); $i++)      for ($i=0; ($i < @pinned_to) && ($i < $n); $i++) {
     {  
1391          $closest{$pinned_to[$i]} = 1;          $closest{$pinned_to[$i]} = 1;
1392      }      }
1393      return return keys(%closest);      return keys(%closest);
1394  }  }
1395    
1396  sub build_maps {  sub build_maps {
# Line 1557  Line 1399 
1399      my($contig1,$beg1,$end1,$map,$peg);      my($contig1,$beg1,$end1,$map,$peg);
1400    
1401      $gg = [];      $gg = [];
1402      foreach $peg (@$pinned_pegs)      foreach $peg (@$pinned_pegs) {
     {  
1403          $loc = &feature_locationS($fig_or_sprout,$peg);          $loc = &feature_locationS($fig_or_sprout,$peg);
1404          ($contig,$beg,$end) = &boundaries_of($fig_or_sprout,$loc);          ($contig,$beg,$end) = &boundaries_of($fig_or_sprout,$loc);
1405          if ($contig && $beg && $end)          if ($contig && $beg && $end) {
         {  
1406              $mid = int(($beg + $end) / 2);              $mid = int(($beg + $end) / 2);
1407              $min = int($mid - ($sz_region / 2));              $min = int($mid - ($sz_region / 2));
1408              $max = int($mid + ($sz_region / 2));              $max = int($mid + ($sz_region / 2));
1409              $genes = [];              $genes = [];
1410              ($feat,undef,undef) = &genes_in_region($fig_or_sprout,&genome_of($peg),$contig,$min,$max);              ($feat,undef,undef) = &genes_in_region($fig_or_sprout,&genome_of($peg),$contig,$min,$max);
1411              foreach $fid (@$feat)              foreach $fid (@$feat) {
             {  
1412                  ($contig1,$beg1,$end1) = &boundaries_of($fig_or_sprout,&feature_locationS($fig_or_sprout,$fid));                  ($contig1,$beg1,$end1) = &boundaries_of($fig_or_sprout,&feature_locationS($fig_or_sprout,$fid));
1413                  $beg1 = &in_bounds($min,$max,$beg1);                  $beg1 = &in_bounds($min,$max,$beg1);
1414                  $end1 = &in_bounds($min,$max,$end1);                  $end1 = &in_bounds($min,$max,$end1);
# Line 1595  Line 1434 
1434                                $fid,                                $fid,
1435                                $info, $fmg]);                                $info, $fmg]);
1436    
1437                  if ($fid =~ /peg/)                  if ($fid =~ /peg/) {
                 {  
1438                      push(@$all_pegs,$fid);                      push(@$all_pegs,$fid);
1439                  }                  }
1440              }              }
# Line 1629  Line 1467 
1467      my($genes,$min) = @_;      my($genes,$min) = @_;
1468      my($gene);      my($gene);
1469    
1470      foreach $gene (@$genes)      foreach $gene (@$genes) {
     {  
1471          $gene->[0] -= $min;          $gene->[0] -= $min;
1472          $gene->[1] -= $min;          $gene->[1] -= $min;
1473      }      }
# Line 1641  Line 1478 
1478      my($genes,$min,$max) = @_;      my($genes,$min,$max) = @_;
1479      my($gene);      my($gene);
1480    
1481      foreach $gene (@$genes)      foreach $gene (@$genes) {
     {  
1482          ($gene->[0],$gene->[1]) = ($max - $gene->[1],$max - $gene->[0]);          ($gene->[0],$gene->[1]) = ($max - $gene->[1],$max - $gene->[0]);
1483          $gene->[2] = ($gene->[2] eq "rightArrow") ? "leftArrow" : "rightArrow";          $gene->[2] = ($gene->[2] eq "rightArrow") ? "leftArrow" : "rightArrow";
1484      }      }
# Line 1656  Line 1492 
1492      my @color_sets = ();      my @color_sets = ();
1493    
1494      $conn = &get_connections_by_similarity($all_pegs);      $conn = &get_connections_by_similarity($all_pegs);
1495      for ($i=0; ($i < @$all_pegs); $i++)      for ($i=0; ($i < @$all_pegs); $i++) {
     {  
1496          if ($all_pegs->[$i] eq $peg) { $pegI = $i }          if ($all_pegs->[$i] eq $peg) { $pegI = $i }
1497          if (! $seen{$i})          if (! $seen{$i}) {
         {  
1498              $cluster = [$i];              $cluster = [$i];
1499              $seen{$i} = 1;              $seen{$i} = 1;
1500              for ($j=0; ($j < @$cluster); $j++)              for ($j=0; ($j < @$cluster); $j++) {
             {  
1501                  $x = $conn->{$cluster->[$j]};                  $x = $conn->{$cluster->[$j]};
1502                  foreach $k (@$x)                  foreach $k (@$x) {
1503                  {                      if (! $seen{$k}) {
                     if (! $seen{$k})  
                     {  
1504                          push(@$cluster,$k);                          push(@$cluster,$k);
1505                          $seen{$k} = 1;                          $seen{$k} = 1;
1506                      }                      }
1507                  }                  }
1508              }              }
1509    
1510              if ((@$cluster > 1) || ($cluster->[0] eq $pegI))              if ((@$cluster > 1) || ($cluster->[0] eq $pegI)) {
             {  
1511                  push(@color_sets,$cluster);                  push(@color_sets,$cluster);
1512              }              }
1513          }          }
# Line 1689  Line 1519 
1519      unshift(@color_sets,$red_set);      unshift(@color_sets,$red_set);
1520    
1521      my $color_sets = {};      my $color_sets = {};
1522      for ($i=0; ($i < @color_sets); $i++)      for ($i=0; ($i < @color_sets); $i++) {
1523      {          foreach $x (@{$color_sets[$i]}) {
         foreach $x (@{$color_sets[$i]})  
         {  
1524              $color_sets->{$all_pegs->[$x]} = $i;              $color_sets->{$all_pegs->[$x]} = $i;
1525          }          }
1526      }      }
# Line 1704  Line 1532 
1532      my($i,$j,$tmp,$peg,%pos_of);      my($i,$j,$tmp,$peg,%pos_of);
1533      my($sim,%conn,$x,$y);      my($sim,%conn,$x,$y);
1534    
1535      for ($i=0; ($i < @$all_pegs); $i++)      for ($i=0; ($i < @$all_pegs); $i++) {
     {  
1536          $tmp = &maps_to_id($fig_or_sprout,$all_pegs->[$i]);          $tmp = &maps_to_id($fig_or_sprout,$all_pegs->[$i]);
1537          push(@{$pos_of{$tmp}},$i);             # map the representative in nr to subscript in all_pegs          push(@{$pos_of{$tmp}},$i);             # map the representative in nr to subscript in all_pegs
1538          if ($tmp ne $all_pegs->[$i])          if ($tmp ne $all_pegs->[$i]) {
         {  
1539              push(@{$pos_of{$all_pegs->[$i]}},$i);              push(@{$pos_of{$all_pegs->[$i]}},$i);
1540          }          }
1541      }      }
1542    
1543      foreach $y (keys(%pos_of))      foreach $y (keys(%pos_of)) {
     {  
1544          $x = $pos_of{$y};          $x = $pos_of{$y};
1545          for ($i=0; ($i < @$x); $i++)          for ($i=0; ($i < @$x); $i++) {
1546          {              for ($j=$i+1; ($j < @$x); $j++) {
             for ($j=$i+1; ($j < @$x); $j++)  
             {  
1547                  push(@{$conn{$x->[$i]}},$x->[$j]);                  push(@{$conn{$x->[$i]}},$x->[$j]);
1548                  push(@{$conn{$x->[$j]}},$x->[$i]);                  push(@{$conn{$x->[$j]}},$x->[$i]);
1549              }              }
1550          }          }
1551      }      }
1552    
1553      for ($i=0; ($i < @$all_pegs); $i++)      for ($i=0; ($i < @$all_pegs); $i++) {
1554      {          foreach $sim (&sims($fig_or_sprout,$all_pegs->[$i],500,1.0e-5,"raw")) {
1555          foreach $sim (&sims($fig_or_sprout,$all_pegs->[$i],500,1.0e-5,"raw"))              if (defined($x = $pos_of{$sim->id2})) {
1556          {                  foreach $y (@$x) {
             if (defined($x = $pos_of{$sim->id2}))  
             {  
                 foreach $y (@$x)  
                 {  
1557                      push(@{$conn{$i}},$y);                      push(@{$conn{$i}},$y);
1558                  }                  }
1559              }              }
# Line 1747  Line 1566 
1566      my($gg,$all_pegs,$color_sets) = @_;      my($gg,$all_pegs,$color_sets) = @_;
1567      my($map,$gene,$peg,$color);      my($map,$gene,$peg,$color);
1568    
1569      foreach $map (@$gg)      foreach $map (@$gg) {
1570      {          foreach $gene (@{$map->[3]}) {
         foreach $gene (@{$map->[3]})  
         {  
1571              $peg = $gene->[5];              $peg = $gene->[5];
1572              if (defined($color = $color_sets->{$peg}))              if (defined($color = $color_sets->{$peg})) {
             {  
1573                  $gene->[3] = ($color == 0) ? "red" : "color$color";                  $gene->[3] = ($color == 0) ? "red" : "color$color";
1574                  $gene->[4] = $color + 1;                  $gene->[4] = $color + 1;
1575              }              }
# Line 1780  Line 1596 
1596    
1597      $g = &genome_of($peg);      $g = &genome_of($peg);
1598    
1599      foreach $peg1 (@$closest_pegs)      foreach $peg1 (@$closest_pegs) {
1600      {          if ($g ne &genome_of($peg1)) {
1601          if ($g ne &genome_of($peg1))              foreach $sim (&sims($fig_or_sprout,$peg1,500,1.0e-5,"all")) {
         {  
             foreach $sim (&sims($fig_or_sprout,$peg1,500,1.0e-5,"all"))  
             {  
1602                  $id2 = $sim->id2;                  $id2 = $sim->id2;
1603                  if (($id2 ne $peg) && ($id2 =~ /^fig\|$g\./) && &possibly_truncated($fig_or_sprout,$id2))                  if (($id2 ne $peg) && ($id2 =~ /^fig\|$g\./) && &possibly_truncated($fig_or_sprout,$id2)) {
                 {  
1604                      $poss{$id2} = 1;                      $poss{$id2} = 1;
1605                  }                  }
1606              }              }
# Line 1800  Line 1612 
1612  sub display_page {  sub display_page {
1613      my($fig_or_sprout,$cgi,$html) = @_;      my($fig_or_sprout,$cgi,$html) = @_;
1614    
1615      if (ref($html) eq "ARRAY")      if (ref($html) eq "ARRAY") {
1616      {          if ($traceData) {
1617                push @$html, QTrace('html');
1618            }
1619          &HTML::show_page($cgi,$html);          &HTML::show_page($cgi,$html);
1620        } else {
1621            Trace(Dumper($html)) if T(2);
1622            if ($cgi->param('SPROUT')) {
1623                if ($traceData) {
1624                    $html->{tracings} = "<h3>Trace Messages</h3>\n" . QTrace('html');
1625                } else {
1626                    $html->{tracings} = "\n";
1627      }      }
     else  
     {  
         if ($cgi->param('SPROUT'))  
         {  
1628              print "Content-Type: text/html\n";              print "Content-Type: text/html\n";
1629              print "\n";              print "\n";
1630              my $templ = "$FIG_Config::fig/CGI/Html/Protein_tmpl.html";              my $templ = "$FIG_Config::fig/CGI/Html/Protein_tmpl.html";
1631              my $templ_txt = &FIG::file_read($templ);              print PageBuilder::Build(">$templ", $html);
1632              my $page = new PageBuilder($templ_txt, $html);          } else {
             print $page->Build($templ_txt, $html);  
             $page->Finish();  
 #           &HTML::BuildPage($html);  
         }  
         else  
         {  
1633              my $gathered = [];              my $gathered = [];
1634    
1635              my $section;              my $section;
# Line 1835  Line 1646 
1646                                    compare_region                                    compare_region
1647                                    similarities                                    similarities
1648                                    tools                                    tools
1649                                    )                        ) ) {
1650                                )                  if (@{$html->{$section}} > 0) {
             {  
                 if (@{$html->{$section}} > 0)  
                 {  
1651                      push(@$gathered,@{$html->{$section}});                      push(@$gathered,@{$html->{$section}});
1652                      push(@$gathered,$cgi->hr);                      push(@$gathered,$cgi->hr);
1653                  }                  }
# Line 1882  Line 1690 
1690      if ($cgi->param('translate')) {      if ($cgi->param('translate')) {
1691          $url =~ s/[;&]translate(=[^;&])?//i or $url =~ s/translate(=[^;&])?[;&]//i;          $url =~ s/[;&]translate(=[^;&])?//i or $url =~ s/translate(=[^;&])?[;&]//i;
1692          $msg = "Turn Off Function Translation";          $msg = "Turn Off Function Translation";
1693      }      } else {
     else  
     {  
1694          $url .= ";translate=1";          $url .= ";translate=1";
1695          $msg = "Translate Function Assignments";          $msg = "Translate Function Assignments";
1696      }      }
# Line 2157  Line 1963 
1963    
1964      (@x > 0) || return undef;      (@x > 0) || return undef;
1965      $min = $x[0];      $min = $x[0];
1966      for ($i=1; ($i < @x); $i++)      for ($i=1; ($i < @x); $i++) {
     {  
1967          $min = ($min > $x[$i]) ? $x[$i] : $min;          $min = ($min > $x[$i]) ? $x[$i] : $min;
1968      }      }
1969      return $min;      return $min;
# Line 2170  Line 1975 
1975    
1976      (@x > 0) || return undef;      (@x > 0) || return undef;
1977      $max = $x[0];      $max = $x[0];
1978      for ($i=1; ($i < @x); $i++)      for ($i=1; ($i < @x); $i++) {
     {  
1979          $max = ($max < $x[$i]) ? $x[$i] : $max;          $max = ($max < $x[$i]) ? $x[$i] : $max;
1980      }      }
1981      return $max;      return $max;
# Line 2187  Line 1991 
1991  sub ftype {  sub ftype {
1992      my($feature_id) = @_;      my($feature_id) = @_;
1993    
1994      if ($feature_id =~ /^fig\|\d+\.\d+\.([^\.]+)/)      if ($feature_id =~ /^fig\|\d+\.\d+\.([^\.]+)/) {
     {  
1995          return $1;          return $1;
1996      }      }
1997      return undef;      return undef;
# Line 2199  Line 2002 
2002    
2003      return &FIG::abbrev($genome_name);      return &FIG::abbrev($genome_name);
2004  }  }
   

Legend:
Removed from v.1.59  
changed lines
  Added in v.1.60

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3