[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.52, Fri Dec 17 14:53:32 2004 UTC revision 1.53, Thu Jan 6 00:47:45 2005 UTC
# Line 1  Line 1 
1  #### start ####  
2  use FIG;  use FIG;
3  my $fig = new FIG;  use SproutFIG;
4  use FIGGenDB;  use FIGGenDB;
5  use FIGjs;  use FIGjs;
6    
# Line 41  Line 41 
41      exit;      exit;
42  }  }
43    
44    my($fig_or_sprout);
45    if ($cgi->param('SPROUT'))
46    {
47        $fig_or_sprout = new SproutFIG;
48    }
49    else
50    {
51        $fig_or_sprout = new FIG;
52    }
53    
54  my $html = [];  my $html = [];
55    
56  unshift @$html, "<TITLE>The SEED Protein Page</TITLE>\n";  unshift @$html, "<TITLE>The SEED Protein Page</TITLE>\n";
57    
58  my $prot = $cgi->param('prot');  my $prot = $cgi->param('prot');
# Line 49  Line 60 
60  {  {
61      unshift @$html, "<TITLE>The SEED: Protein Page</TITLE>\n";      unshift @$html, "<TITLE>The SEED: Protein Page</TITLE>\n";
62      push(@$html,"<h1>Sorry, you need to specify a protein</h1>\n");      push(@$html,"<h1>Sorry, you need to specify a protein</h1>\n");
63      &HTML::show_page($cgi,$html);      &display_page($fig_or_sprout,$cgi,$html);
64      exit;      exit;
65  }  }
66    
   
67  if ($prot !~ /^fig\|/)  if ($prot !~ /^fig\|/)
68  {  {
69      my @poss = $fig->by_alias($prot);      my @poss = &by_alias($fig_or_sprout,$prot);
70    
71      if (@poss > 0)      if (@poss > 0)
72      {      {
73          $prot = $poss[0];          $prot = $poss[0];
# Line 65  Line 76 
76      {      {
77          unshift @$html, "<TITLE>The SEED: Protein Page</TITLE>\n";          unshift @$html, "<TITLE>The SEED: Protein Page</TITLE>\n";
78          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");
79          &HTML::show_page($cgi,$html);          &display_page($fig_or_sprout,$cgi,$html);
80          exit;          exit;
81      }      }
82  }  }
83    
84    
85  #  #
86  #  Allow previous and next actions in calls to the script -- GJO  #  Allow previous and next actions in calls to the script -- GJO
87  #  #
# Line 79  Line 91 
91      my ( $prefix, $protnum ) = $prot =~ /^(.*\.)(\d+)$/;      my ( $prefix, $protnum ) = $prot =~ /^(.*\.)(\d+)$/;
92      if ( $prefix && $protnum ) {      if ( $prefix && $protnum ) {
93          my $prot2 = $prefix . ($protnum + $adjust);          my $prot2 = $prefix . ($protnum + $adjust);
94          if ( $fig->translatable( $prot2 ) ) {          if ( &translatable($fig_or_sprout, $prot2 ) ) {
95              $prot = $prot2;              $prot = $prot2;
96              $cgi->delete('prot');              $cgi->delete('prot');
97              $cgi->param(-name => 'prot', -value => $prot);              $cgi->param(-name => 'prot', -value => $prot);
# Line 91  Line 103 
103    
104  my $request = $cgi->param("request") || "";  my $request = $cgi->param("request") || "";
105    
106  if    ($request eq "use_protein_tool")       { &use_protein_tool($fig,$cgi,$html,$prot); }  if    ($request eq "use_protein_tool")       { &use_protein_tool($fig_or_sprout,$cgi,$html,$prot); }
107  elsif ($request eq "view_annotations")       { &view_annotations($fig,$cgi,$html,$prot); }  elsif ($request eq "view_annotations")       { &view_annotations($fig_or_sprout,$cgi,$html,$prot); }
108  elsif ($request eq "view_all_annotations")   { &view_all_annotations($fig,$cgi,$html,$prot); }  elsif ($request eq "view_all_annotations")   { &view_all_annotations($fig_or_sprout,$cgi,$html,$prot); }
109  elsif ($request eq "aa_sequence")            { &aa_sequence($fig,$cgi,$html,$prot); }  elsif ($request eq "aa_sequence")            { &aa_sequence($fig_or_sprout,$cgi,$html,$prot); }
110  elsif ($request eq "dna_sequence")           { &dna_sequence($fig,$cgi,$html,$prot); }  elsif ($request eq "dna_sequence")           { &dna_sequence($fig_or_sprout,$cgi,$html,$prot); }
111  elsif ($request eq "fast_assign")            { &make_assignment($fig,$cgi,$html,$prot); }  elsif ($request eq "fast_assign")            { $html = &make_assignment($fig_or_sprout,$cgi,$html,$prot); }
112  elsif ($request eq "show_coupling_evidence") { &show_coupling_evidence($fig,$cgi,$html,$prot); }  elsif ($request eq "show_coupling_evidence") { &show_coupling_evidence($fig_or_sprout,$cgi,$html,$prot); }
113  elsif ($request eq "ec_to_maps")             { &show_ec_to_maps($fig,$cgi,$html); }  elsif ($request eq "ec_to_maps")             { &show_ec_to_maps($fig_or_sprout,$cgi,$html); }
114  elsif ($request eq "link_to_map")            { &link_to_map($fig,$cgi,$html); }  elsif ($request eq "link_to_map")            { &link_to_map($fig_or_sprout,$cgi,$html); }
115  elsif ($request eq "fusions")                { &show_fusions($fig,$cgi,$html,$prot); }  elsif ($request eq "fusions")                { &show_fusions($fig_or_sprout,$cgi,$html,$prot); }
116  else                                         { &show_initial($fig,$cgi,$html,$prot); }  else
117    {
118        $html = &show_html_followed_by_initial($fig_or_sprout,$cgi,$html,$prot);
119    }
120    
121  &HTML::show_page($cgi,$html);  &display_page($fig_or_sprout,$cgi,$html);
122  exit;  exit;
123    
124  #==============================================================================  #==============================================================================
# Line 111  Line 126 
126  #==============================================================================  #==============================================================================
127    
128  sub use_protein_tool {  sub use_protein_tool {
129      my($fig,$cgi,$html,$prot) = @_;      my($fig_or_sprout,$cgi,$html,$prot) = @_;
130      my($url,$method,@args,$line,$name,$val);      my($url,$method,@args,$line,$name,$val);
131    
132      my $seq = $fig->get_translation($prot);      my $seq = &get_translation($fig_or_sprout,$prot);
133      if (! $seq)      if (! $seq)
134      {      {
135          unshift @$html, "<TITLE>The SEED: Protein Page</TITLE>\n";          unshift @$html, "<TITLE>The SEED: Protein Page</TITLE>\n";
# Line 149  Line 164 
164  #==============================================================================  #==============================================================================
165    
166  sub make_assignment {  sub make_assignment {
167      my($fig,$cgi,$html,$prot) = @_;      my($fig_or_sprout,$cgi,$html,$prot) = @_;
168      my($userR);      my($userR);
169    
170      my $function = $cgi->param('func');      my $function = $cgi->param('func');
# Line 160  Line 175 
175          if ($user =~ /master:(.*)/)          if ($user =~ /master:(.*)/)
176          {          {
177              $userR = $1;              $userR = $1;
178              $fig->assign_function($prot,"master",$function,"");              &assign_function($fig_or_sprout,$prot,"master",$function,"");
179              $fig->add_annotation($prot,$userR,"Set master function to\n$function\n");              &add_annotation($fig_or_sprout,$prot,$userR,"Set master function to\n$function\n");
180          }          }
181          else          else
182          {          {
183              $fig->assign_function($prot,$user,$function,"");              &assign_function($fig_or_sprout,$prot,$user,$function,"");
184              $fig->add_annotation($prot,$user,"Set function to\n$function\n");              &add_annotation($fig_or_sprout,$prot,$user,"Set function to\n$function\n");
185          }          }
186      }      }
187      $cgi->delete("request");      $cgi->delete("request");
188      $cgi->delete("func");      $cgi->delete("func");
189      &show_initial($fig,$cgi,$html,$prot);      $html = &show_html_followed_by_initial($fig_or_sprout,$cgi,$html,$prot);
190        return $html;
191  }  }
192    
193  #==============================================================================  #==============================================================================
# Line 179  Line 195 
195  #==============================================================================  #==============================================================================
196    
197  sub view_annotations {  sub view_annotations {
198      my($fig,$cgi,$html,$prot) = @_;      my($fig_or_sprout,$cgi,$html,$prot) = @_;
199    
200      unshift @$html, "<TITLE>The SEED: Protein Annotations</TITLE>\n";      unshift @$html, "<TITLE>The SEED: Protein Annotations</TITLE>\n";
201      my $col_hdrs = ["who","when","annotation"];      my $col_hdrs = ["who","when","annotation"];
202      my $tab = [ map { [$_->[2],$_->[1],"<pre>" . $_->[3] . "<\/pre>"] } $fig->feature_annotations($prot) ];      my $tab = [ map { [$_->[2],$_->[1],"<pre>" . $_->[3] . "<\/pre>"] } &feature_annotations($fig_or_sprout,$prot) ];
203      if (@$tab > 0)      if (@$tab > 0)
204      {      {
205          push(@$html,&HTML::make_table($col_hdrs,$tab,"Annotations for $prot"));          push(@$html,&HTML::make_table($col_hdrs,$tab,"Annotations for $prot"));
# Line 195  Line 211 
211  }  }
212    
213  sub view_all_annotations {  sub view_all_annotations {
214      my($fig,$cgi,$html,$peg) = @_;      my($fig_or_sprout,$cgi,$html,$peg) = @_;
215      my($ann);      my($ann);
216    
217      unshift @$html, "<TITLE>The SEED: Protein Annotations</TITLE>\n";      unshift @$html, "<TITLE>The SEED: Protein Annotations</TITLE>\n";
218      if ($fig->is_real_feature($peg))      if (&is_real_feature($fig_or_sprout,$peg))
219      {      {
220          my $col_hdrs = ["who","when","PEG","genome","annotation"];          my $col_hdrs = ["who","when","PEG","genome","annotation"];
221          my @related  = $fig->related_by_func_sim($peg,$cgi->param('user'));          my @related  = &related_by_func_sim($fig_or_sprout,$peg,$cgi->param('user'));
222          push(@related,$peg);          push(@related,$peg);
223    
224          my @annotations = $fig->merged_related_annotations(\@related);          my @annotations = &merged_related_annotations($fig_or_sprout,\@related);
225    
226          my $tab = [ map { $ann = $_;          my $tab = [ map { $ann = $_;
227                            [$ann->[2],$ann->[1],&HTML::fid_link($cgi,$ann->[0]),                            [$ann->[2],$ann->[1],&HTML::fid_link($cgi,$ann->[0]),
228                             $fig->genus_species(&FIG::genome_of($ann->[0])),                             &genus_species($fig_or_sprout,&genome_of($ann->[0])),
229                             "<pre>" . $ann->[3] . "</pre>"                             "<pre>" . $ann->[3] . "</pre>"
230                             ] } @annotations];                             ] } @annotations];
231          if (@$tab > 0)          if (@$tab > 0)
# Line 228  Line 244 
244  #==============================================================================  #==============================================================================
245    
246  sub show_coupling_evidence {  sub show_coupling_evidence {
247      my($fig,$cgi,$html,$peg) = @_;      my($fig_or_sprout,$cgi,$html,$peg) = @_;
248      my($pair,$peg1,$peg2,$link1,$link2);      my($pair,$peg1,$peg2,$link1,$link2);
249    
250      unshift @$html, "<TITLE>The SEED: Functional Coupling</TITLE>\n";      unshift @$html, "<TITLE>The SEED: Functional Coupling</TITLE>\n";
251      my $user = $cgi->param('user');      my $user = $cgi->param('user');
252      my $to   = $cgi->param('to');      my $to   = $cgi->param('to');
253      my @coup = grep { $_->[1] eq $to } $fig->coupling_and_evidence($peg,5000,1.0e-10,4,"keep");      my @coup = grep { $_->[1] eq $to } &coupling_and_evidence($fig_or_sprout,$peg,5000,1.0e-10,4);
254    
255      if (@coup != 1)      if (@coup != 1)
256      {      {
# Line 250  Line 266 
266              $link1 = &HTML::fid_link($cgi,$peg1);              $link1 = &HTML::fid_link($cgi,$peg1);
267              $link2 = &HTML::fid_link($cgi,$peg2);              $link2 = &HTML::fid_link($cgi,$peg2);
268              push( @$tab, [ $link1,              push( @$tab, [ $link1,
269                             $fig->org_of($peg1),                             &org_of($fig_or_sprout,$peg1),
270                             scalar $fig->function_of($peg1,$user),                             scalar &function_ofS($fig_or_sprout,$peg1,$user),
271                             $link2,                             $link2,
272                             $fig->org_of($peg2),                             &org_of($fig_or_sprout,$peg2),
273                             scalar $fig->function_of($peg2,$user)                             scalar &function_ofS($fig_or_sprout,$peg2,$user)
274                           ]                           ]
275                  );                  );
276          }          }
# Line 267  Line 283 
283  #==============================================================================  #==============================================================================
284    
285  sub psi_blast_prot_sequence {  sub psi_blast_prot_sequence {
286      my($fig,$cgi,$prot_id) = @_;      my($fig_or_sprout,$cgi,$prot_id) = @_;
287  }  }
288    
289  #==============================================================================  #==============================================================================
# Line 275  Line 291 
291  #==============================================================================  #==============================================================================
292    
293  sub show_initial {  sub show_initial {
294      my($fig,$cgi,$html,$prot) = @_;      my($fig_or_sprout,$cgi,$html,$prot) = @_;
295    
296      unshift @$html, "<TITLE>The SEED: Protein Page</TITLE>\n";      unshift @{$html->{general}}, "<TITLE>The SEED: Protein Page</TITLE>\n";
297      my $gs = $fig->org_of($prot);  
298        my $gs = &org_of($fig_or_sprout,$prot);
299      if ($prot =~ /^fig\|\d+\.\d+\.peg/)      if ($prot =~ /^fig\|\d+\.\d+\.peg/)
300      {      {
301          if (! $fig->is_real_feature($prot))          if (! &is_real_feature($fig_or_sprout,$prot))
302          {          {
303              push(@$html,"<h1>Sorry, $prot is an unknown identifier</h1>\n");              push(@{$html->{general}},"<h1>Sorry, $prot is an unknown identifier</h1>\n");
304          }          }
305          else          else
306          {          {
307              push(@$html,"<h1>Protein $prot: $gs</h1>\n");              push(@{$html->{general}},"<h1>Protein $prot: $gs</h1>\n");
308              my $msg;              &translation_piece($fig_or_sprout,$cgi,$html->{translate_status});
309              my $url = $cgi->self_url();              &display_peg($fig_or_sprout,$cgi,$html,$prot);
             if ($cgi->param('translate')) {  
                 $url =~ s/[;&]translate(=[^;&])?//i or $url =~ s/translate(=[^;&])?[;&]//i;  
                 $msg = "Turn Off Function Translation";  
             }  
             else  
             {  
                 $url .= ";translate=1";  
                 $msg = "Translate Function Assignments";  
             }  
             push(@$html, "<a href=\"$url\">$msg</a><br>\n");  
   
             &display_peg($fig,$cgi,$html,$prot);  
310          }          }
311      }      }
312      else      else
313      {      {
314  #       &display_external($fig,$cgi,$html,$prot);  #       &display_external($fig_or_sprout,$cgi,$html,$prot);
315      }      }
316  }  }
317    
# Line 315  Line 320 
320  #==============================================================================  #==============================================================================
321    
322  sub display_peg {  sub display_peg {
323      my($fig,$cgi,$html,$peg) = @_;      my($fig_or_sprout,$cgi,$html,$peg) = @_;
324      my $loc;      my $loc;
325    
326        my $user = $cgi->param('user');
327    
328      my $half_sz = 5000;      my $half_sz = 5000;
329      my $fc = $cgi->param('fc');      my $fc = $cgi->param('fc');
330      my @fc_data;      my @fc_data;
# Line 332  Line 339 
339          if ($cgi->param('fcsim')) {$sim_cutoff=$cgi->param('fcsim')}          if ($cgi->param('fcsim')) {$sim_cutoff=$cgi->param('fcsim')}
340          if ($cgi->param('fccoup')) {$coupling_cutoff=$cgi->param('fccoup')}          if ($cgi->param('fccoup')) {$coupling_cutoff=$cgi->param('fccoup')}
341    
342          @fc_data = $fig->coupling_and_evidence($peg,$bound,$sim_cutoff,$coupling_cutoff,"keep");          @fc_data = &coupling_and_evidence($fig_or_sprout,$peg,$bound,$sim_cutoff,$coupling_cutoff);
343      }      }
344      else      else
345      {      {
346          @fc_data = ();          @fc_data = ();
347      }      }
348    
349      if ($loc = $fig->feature_location($peg))      if ($loc = &feature_locationS($fig_or_sprout,$peg))
     {  
         my($contig,$beg,$end) = &FIG::boundaries_of($loc);  
         my $min = &FIG::max(0,&FIG::min($beg,$end) - $half_sz);  
         my $max = &FIG::max($beg,$end) + $half_sz;  
         my($feat,$min,$max) = $fig->genes_in_region(&FIG::genome_of($peg),$contig,$min,$max);  
   
         &print_context($fig,$cgi,$html,$peg,$feat,$min,$max);  
     }  
   
     &print_assignments($fig,$cgi,$html,$peg);  
         push @$html, "\n", &FIGjs::toolTipScript();  
   
     push(@$html,$cgi->hr);  
     my $link1 = $cgi->self_url() . "&request=view_annotations";  
     my $link2 = $cgi->self_url() . "&request=view_all_annotations";  
     push(@$html,"<br><a href=$link1>To View Annotations</a>/<a href=$link2>To View All Related Annotations</a>\n");  
   
     push(@$html, "<br/>".&FIGGenDB::linkPEGGenDB($peg));  
     push(@$html, "<br/>".&FIGGenDB::importOrganismGenDB($peg));  
   
     my $link = $cgi->self_url() . "&request=aa_sequence";  
     push(@$html,"<br><a href=$link>Protein Sequence</a>\n");  
   
     $link = $cgi->self_url() . "&request=dna_sequence";  
     push(@$html,"<br><a href=$link>DNA Sequence</a>\n");  
   
     $link = $cgi->url();  
     $link =~ s/protein.cgi/fid_checked.cgi/;  
     my $user = $cgi->param('user');  
     if (! $user)  
     {  
         $user = "";  
     }  
     else  
     {  
         $link = $link . "?fid=$prot&user=$user&checked=$prot&assign/annotate=assign/annotate";  
         push(@$html,"<br><a href=$link target=checked_window>To Make an Annotation</a>\n");  
     }  
   
     if ((! $fc) && ($fig->feature_location($peg)))  
350      {      {
351          my $link = $cgi->self_url() . "&fc=1";          my($contig,$beg,$end) = &boundaries_of($fig_or_sprout,$loc);
352          push(@$html,"<br><a href=$link>To Get Detailed Functional Coupling Data</a>\n");          my $min = &max(0,&min($beg,$end) - $half_sz);
353      }          my $max = &max($beg,$end) + $half_sz;
354      elsif ($fc)          my($feat,$min,$max) = &genes_in_region($fig_or_sprout,&genome_of($peg),$contig,$min,$max);
     {  
         &print_fc($fig,$cgi,$html,$peg,\@fc_data);  
     }  
   
     my $link = $cgi->self_url() . "&request=fusions";  
     push(@$html,"<br><a href=$link>To Get Fusion Data</a>\n");  
355    
356      my $link = &FIG::cgi_url . "/homologs_in_clusters.cgi?prot=$peg&user=$user\n";          my ($beg,$end,$genes) = &print_context($fig_or_sprout,$cgi,$html->{contig_context},$peg,$feat,$min,$max);
357      push(@$html,"<br><a href=$link>To Find Homologs in Clusters</a>\n");          &print_graphics_context($beg,$end,$genes,$html->{context_graphic});
   
     my $has_translation = $fig->translatable($peg);  
     if ((! $cgi->param('compare_region')) && $has_translation)  
     {  
         my $link = $cgi->self_url() . "&compare_region=1";  
         push(@$html,"<br><a href=$link>To Compare Region</a>\n");  
     }  
     elsif ($cgi->param('compare_region'))  
     {  
         &print_compared_regions($fig,$cgi,$html,$peg);  
358      }      }
359    
360        &print_assignments($fig_or_sprout,$cgi,$html->{assgn_for_equiv_prots},$peg);
361        &print_kv_pairs($fig_or_sprout,$cgi,$html->{kv_pairs},$peg);
362        &print_subsys_connections($fig_or_sprout,$cgi,$html->{subsys_connections},$peg,$user);
363        &print_links($fig_or_sprout,$cgi,$html->{links},$peg);
364    
365      my $sims = $cgi->param('sims');      push @{$html->{javascript}}, "\n", &FIGjs::toolTipScript();
     if ((! $sims) && $has_translation)  
     {  
         my $max_expand = $cgi->param('max_expand') ||  5;  
         my $maxN       = $cgi->param('maxN')       || 50;   #  Default 50, not 5 (GJO)  
         my $maxP       = $cgi->param('maxP')       ||  1.0e-5;  
         my $ex_raw     = $cgi->param('expand_raw') ||  0;   #  Default 0, not 1 (GJO)  
         my $just_fig   = $cgi->param('just_fig')   ||  0;  
         my $show_env   = $cgi->param('show_env')   ||  0;  
         my $hide_alias = $cgi->param('hide_alias') ||  0;  
366    
367          push( @$html, $cgi->start_form(-action => "protein.cgi#Similarities"));      my $has_translation = &translatable($fig_or_sprout,$peg);
368          if ($cgi->param('translate'))      &print_services($fig_or_sprout,$cgi,$html->{services},$peg,$has_translation,\@fc_data);
369          {      &print_sims_block($fig_or_sprout,$cgi,$html->{similarities},$peg,$user,$has_translation);
             push(@$html,$cgi->hidden(-name => 'translate', -value => 1));  
         }  
         push( @$html, $cgi->hidden(-name => 'prot', -value => $peg),  
                       $cgi->hidden(-name => 'sims', -value => 1),  
                       $cgi->hidden(-name => 'fid',  -value => $peg),  
                       $cgi->hidden(-name => 'user', -value => $user),  
                       $cgi->submit('Similarities'),  
                       " MaxN: ", $cgi->textfield(-name => 'maxN', -size =>  5, -value => $maxN, -override => 1),  
                       " Max expand: ", $cgi->textfield(-name => 'max_expand', -size =>  5, -value => $max_expand, -override => 1),  
                       " MaxP: ", $cgi->textfield(-name => 'maxP', -size => 10, -value => $maxP),  
                       " Just FIG Ids: ", $cgi->checkbox(-name => 'just_fig', -value => 1, -checked => $just_fig, -override => 1, -label => ""),  
                       " Show Env. samples: ", $cgi->checkbox(-name => 'show_env', -value => 1, -checked => $show_env, -override => 1, -label => ""),  
                       " Hide aliases: ", $cgi->checkbox(-name => 'hide_alias', -value => 1, -checked => $hide_alias, -override => 1, -label => ""),  
                       $cgi->end_form  
             );  
     }  
     elsif ($sims)  
     {  
         &print_similarities($fig,$cgi,$html,$peg);  
     }  
370    
371      if ($has_translation)      if ($has_translation)
372      {      {
373          &show_tools($fig,$cgi,$html,$peg);          &show_tools($fig_or_sprout,$cgi,$html->{tools},$peg);
374      }      }
375  }  }
376    
377  ################# Table-Driven Show Tools  ############################  ################# Table-Driven Show Tools  ############################
378    
379  sub show_tools {  sub show_tools {
380      my($fig,$cgi,$html,$peg) = @_;      my($fig_or_sprout,$cgi,$html,$peg) = @_;
381    
382      $cgi->param(-name => "request",      $cgi->param(-name => "request",
383                  -value => "use_protein_tool");                  -value => "use_protein_tool");
# Line 459  Line 385 
385    
386      if (open(TMP,"<$FIG_Config::global/LinksToTools"))      if (open(TMP,"<$FIG_Config::global/LinksToTools"))
387      {      {
         push(@$html,$cgi->hr);  
388          my $col_hdrs = ["Tool","Description"];          my $col_hdrs = ["Tool","Description"];
389          my $tab = [];          my $tab = [];
390    
# Line 479  Line 404 
404  ################# Functional Coupling  ############################  ################# Functional Coupling  ############################
405    
406  sub print_fc {  sub print_fc {
407      my($fig,$cgi,$html,$peg,$fc_data) = @_;      my($fig_or_sprout,$cgi,$html,$peg,$fc_data) = @_;
408      my($sc,$neigh);      my($sc,$neigh);
409    
410      my $user  = $cgi->param('user');      my $user  = $cgi->param('user');
411      my @tab   = map { ($sc,$neigh) = @$_;      my @tab   = map { ($sc,$neigh) = @$_;
412                        [&ev_link($cgi,$neigh,$sc),$neigh,scalar $fig->function_of($neigh,$user)]                        [&ev_link($cgi,$neigh,$sc),$neigh,scalar &function_ofS($fig_or_sprout,$neigh,$user)]
413                      }                      }
414                      @$fc_data;                      @$fc_data;
415      if (@tab > 0)      if (@tab > 0)
# Line 506  Line 431 
431  ################# Assignments  ############################  ################# Assignments  ############################
432    
433  sub trans_function_of {  sub trans_function_of {
434      my($cgi,$fig,$peg,$user) = @_;      my($cgi,$fig_or_sprout,$peg,$user) = @_;
435    
436      if (wantarray())      if (wantarray())
437      {      {
438          my $x;          my $x;
439          my @funcs = $fig->function_of($peg);          my @funcs = &function_ofL($fig_or_sprout,$peg);
440          if ($cgi->param('translate'))          if ($cgi->param('translate'))
441          {          {
442              @funcs = map { $x = $_; $x->[1] = $fig->translate_function($x->[1]); $x } @funcs;              @funcs = map { $x = $_; $x->[1] = &translate_function($fig_or_sprout,$x->[1]); $x } @funcs;
443          }          }
444          return @funcs;          return @funcs;
445      }      }
446      else      else
447      {      {
448          my $func = $fig->function_of($peg,$user);          my $func = &function_ofS($fig_or_sprout,$peg,$user);
449          if ($cgi->param('translate'))          if ($cgi->param('translate'))
450          {          {
451              $func = $fig->translate_function($func);              $func = &translate_function($fig_or_sprout,$func);
452          }          }
453          return $func;          return $func;
454      }      }
455  }  }
456    
457    ##########################  Routines that build pieces of HTML ######################
458    
459    
460    sub print_sims_block {
461        my($fig_or_sprout,$cgi,$html,$peg,$user,$has_translation) = @_;
462    
463        my $sims = $cgi->param('sims');
464        if ((! $sims) && $has_translation)
465        {
466            my $max_expand = $cgi->param('max_expand') ||  5;
467            my $maxN       = $cgi->param('maxN')       || 50;   #  Default 50, not 5 (GJO)
468            my $maxP       = $cgi->param('maxP')       ||  1.0e-5;
469            my $ex_raw     = $cgi->param('expand_raw') ||  0;   #  Default 0, not 1 (GJO)
470            my $just_fig   = $cgi->param('just_fig')   ||  0;
471            my $show_env   = $cgi->param('show_env')   ||  0;
472            my $hide_alias = $cgi->param('hide_alias') ||  0;
473    
474            push( @$html, $cgi->start_form(-action => "protein.cgi#Similarities"));
475            if ($cgi->param('translate'))
476            {
477                push(@$html,$cgi->hidden(-name => 'translate', -value => 1));
478            }
479            my $sprout = $cgi->param('SPROUT') ? 1 : "";
480    
481            push( @$html, $cgi->hidden(-name => 'prot', -value => $peg),
482                          $cgi->hidden(-name => 'sims', -value => 1),
483                          $cgi->hidden(-name => 'fid',  -value => $peg),
484                          $cgi->hidden(-name => 'user', -value => $user),
485                          $cgi->hidden(-name => 'SPROUT', -value => $sprout),
486                          $cgi->submit('Similarities'),
487                          " MaxN: ", $cgi->textfield(-name => 'maxN', -size =>  5, -value => $maxN, -override => 1),
488                          " Max expand: ", $cgi->textfield(-name => 'max_expand', -size =>  5, -value => $max_expand, -override => 1),
489                          " MaxP: ", $cgi->textfield(-name => 'maxP', -size => 10, -value => $maxP),
490                          " Just FIG Ids: ", $cgi->checkbox(-name => 'just_fig', -value => 1, -checked => $just_fig, -override => 1, -label => ""),
491                          " Show Env. samples: ", $cgi->checkbox(-name => 'show_env', -value => 1, -checked => $show_env, -override => 1, -label => ""),
492                          " Hide aliases: ", $cgi->checkbox(-name => 'hide_alias', -value => 1, -checked => $hide_alias, -override => 1, -label => ""),
493                          $cgi->end_form
494                );
495        }
496        elsif ($sims)
497        {
498            &print_similarities($fig_or_sprout,$cgi,$html,$peg);
499        }
500    }
501    
502    
503    sub print_services {
504        my($fig_or_sprout,$cgi,$html,$peg,$has_translation,$fc_data) = @_;
505    
506        my $link1 = $cgi->self_url() . "&request=view_annotations";
507        my $link2 = $cgi->self_url() . "&request=view_all_annotations";
508        push(@$html,"<br><a href=$link1>To View Annotations</a>/<a href=$link2>To View All Related Annotations</a>\n");
509    
510        push(@$html, "<br/>".&FIGGenDB::linkPEGGenDB($peg));
511        push(@$html, "<br/>".&FIGGenDB::importOrganismGenDB($peg));
512    
513        my $link = $cgi->self_url() . "&request=aa_sequence";
514        push(@$html,"<br><a href=$link>Protein Sequence</a>\n");
515    
516        $link = $cgi->self_url() . "&request=dna_sequence";
517        push(@$html,"<br><a href=$link>DNA Sequence</a>\n");
518    
519        $link = $cgi->url();
520        $link =~ s/protein.cgi/fid_checked.cgi/;
521        my $sprout = $cgi->param('SPROUT') ? 1 : "";
522        my $user = $cgi->param('user');
523        if (! $user)
524        {
525            $user = "";
526        }
527        else
528        {
529            $link = $link . "?SPROUT=$sprout&fid=$prot&user=$user&checked=$prot&assign/annotate=assign/annotate";
530            push(@$html,"<br><a href=$link target=checked_window>To Make an Annotation</a>\n");
531        }
532    
533        my $fc = $cgi->param('fc');
534        if ((! $fc) && (&feature_locationS($fig_or_sprout,$peg)))
535        {
536            my $link = $cgi->self_url() . "&fc=1";
537            push(@$html,"<br><a href=$link>To Get Detailed Functional Coupling Data</a>\n");
538        }
539        elsif ($fc)
540        {
541            &print_fc($fig_or_sprout,$cgi,$html,$peg,$fc_data);
542        }
543    
544        my $link = $cgi->self_url() . "&request=fusions";
545        push(@$html,"<br><a href=$link>To Get Fusion Data</a>\n");
546    
547        my $sprout = $cgi->param('SPROUT') ? 1 : "";
548        my $link = &cgi_url . "/homologs_in_clusters.cgi?SPROUT=$sprout&prot=$peg&user=$user\n";
549        push(@$html,"<br><a href=$link>To Find Homologs in Clusters</a>\n");
550    
551        if ((! $cgi->param('compare_region')) && $has_translation)
552        {
553            my $link = $cgi->self_url() . "&compare_region=1";
554            push(@$html,"<br><a href=$link>To Compare Region</a>\n");
555        }
556        elsif ($cgi->param('compare_region'))
557        {
558            &print_compared_regions($fig_or_sprout,$cgi,$html,$peg);
559        }
560    }
561    
562  sub print_assignments {  sub print_assignments {
563      my($fig,$cgi,$html,$peg) = @_;      my($fig_or_sprout,$cgi,$html,$peg) = @_;
564      my($who,$func,$ec,@ecs,@tmp,$id,$i,$master_func,$user_func,$x);      my($who,$func,$ec,@ecs,@tmp,$id,$i,$master_func,$user_func,$x);
565    
566      my $user = $cgi->param('user');      my $user = $cgi->param('user');
567      my @funcs    = map { [$peg,@$_] } &trans_function_of($cgi,$fig,$peg);      my @funcs    = map { [$peg,@$_] } &trans_function_of($cgi,$fig_or_sprout,$peg);
568    
569      for ($i=0; ($i < @funcs) && ($funcs[$i]->[1] ne "master"); $i++) {}      for ($i=0; ($i < @funcs) && ($funcs[$i]->[1] ne "master"); $i++) {}
570      if ($i < @funcs)      if ($i < @funcs)
# Line 556  Line 586 
586          $user_func = $master_func;          $user_func = $master_func;
587      }      }
588      push(@$html,$cgi->h2("Current Assignment: $peg: $user_func"));      push(@$html,$cgi->h2("Current Assignment: $peg: $user_func"));
589      my @maps_to  = grep { $_ ne $peg } map { $_->[0] } $fig->mapped_prot_ids($peg);      my @maps_to  = grep { $_ ne $peg } map { $_->[0] } &mapped_prot_ids($fig_or_sprout,$peg);
590      @funcs = ();      @funcs = ();
591      foreach $id (@maps_to)      foreach $id (@maps_to)
592      {      {
593          if (($id ne $peg) && (@tmp = &trans_function_of($cgi,$fig,$id)) && (@tmp > 0))          if (($id ne $peg) && (@tmp = &trans_function_of($cgi,$fig_or_sprout,$id)) && (@tmp > 0))
594          {          {
595              push(@funcs, map { $x = $_; [$id,@$_] } @tmp);              push(@funcs, map { $x = $_; [$id,@$_] } @tmp);
596          }          }
# Line 573  Line 603 
603          push(@$html,$cgi->h1("No function has been assigned"));          push(@$html,$cgi->h1("No function has been assigned"));
604      }      }
605    
606      my $tab = [ map { ($id,$who,$func) = @$_; [ &HTML::set_prot_links($cgi,$id),$fig->org_of($id),$who,($user ? &assign_link($cgi,$func,$user_func) : ""), &set_map_links($fig,&FIG::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 ];
607      if (@$tab > 0)      if (@$tab > 0)
608      {      {
609          my $col_hdrs = ["Id","Organism","Who","ASSIGN","Assignment"];          my $col_hdrs = ["Id","Organism","Who","ASSIGN","Assignment"];
610          my $title    = "Assignments for Essentially Identical Proteins";          my $title    = "Assignments for Essentially Identical Proteins";
611          push(@$html,&HTML::make_table($col_hdrs,$tab,$title));          push(@$html,&HTML::make_table($col_hdrs,$tab,$title));
612      }      }
613    }
614    
615    sub print_kv_pairs {
616        my($fig_or_sprout,$cgi,$html,$peg) = @_;
617    
618        my @attr = &feature_attributes($fig_or_sprout,$peg);
     my @attr = $fig->feature_attributes($peg);  
619      if (@attr > 0)      if (@attr > 0)
620      {      {
621          my $tab = [];          my $tab = [];
# Line 594  Line 626 
626          }          }
627          push(@$html,$cgi->br,$cgi->hr,&HTML::make_table(["Key","Value"],$tab,"Attributes"),$cgi->hr);          push(@$html,$cgi->br,$cgi->hr,&HTML::make_table(["Key","Value"],$tab,"Attributes"),$cgi->hr);
628      }      }
629    }
630    
631    sub print_subsys_connections {
632        my($fig_or_sprout,$cgi,$html,$peg,$user) = @_;
633    
634      #      #
635      # Show the subsystems in which this protein participates.      # Show the subsystems in which this protein participates.
636      #      #
637    
638      if (my @subsystems = $fig->subsystems_for_peg($peg))      if (my @subsystems = &subsystems_for_peg($fig_or_sprout,$peg))
639      {      {
640          push(@$html,          push(@$html,
              $cgi->hr,  
641               $cgi->h2("Subsystems in which this peg is present"));               $cgi->h2("Subsystems in which this peg is present"));
642    
643          my(@hdrs);          my(@hdrs);
# Line 610  Line 645 
645    
646          @hdrs = ("Subsystem", "Role");          @hdrs = ("Subsystem", "Role");
647    
648            my $sprout = $cgi->param('SPROUT') ? 1 : "";
649    
650          for my $ent (@subsystems)          for my $ent (@subsystems)
651          {          {
652              my($sub, $role) = @$ent;              my($sub, $role) = @$ent;
653              my $url = $cgi->a({href => "ssa2.cgi?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);
654              push(@table, [$url, $role]);              push(@table, [$url, $role]);
655          }          }
656          push(@$html, &HTML::make_table(\@hdrs, \@table));          push(@$html, &HTML::make_table(\@hdrs, \@table));
657      }      }
658    }
659    
660      push(@$html,$cgi->hr);  sub print_links {
661        my($fig_or_sprout,$cgi,$html,$peg) = @_;
662    
663      my @links = $fig->peg_links($peg);      my @links = &peg_links($fig_or_sprout,$peg)
664    ;
665      if (@links > 0)      if (@links > 0)
666      {      {
667          my $col_hdrs = [1,2,3,4,5];          my $col_hdrs = [1,2,3,4,5];
# Line 636  Line 676 
676          push(@$html,&HTML::make_table($col_hdrs,$tab,$title));          push(@$html,&HTML::make_table($col_hdrs,$tab,$title));
677      }      }
678    
679      my $url = &FIG::cgi_url . "/add_links.cgi?peg=$peg";      if (! $cgi->param('SPROUT'))
680        {
681            my $url = &cgi_url . "/add_links.cgi?peg=$peg";
682      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");
683        }
 #    $_ = join("",map { $_->[1] } @funcs);  
 #    @ecs = ($_ =~ /\d\.\d+\.\d+\.\d+/g);  
 #    foreach $ec (@ecs)  
 #    {  
 #       my $kegg_link = &HTML::kegg_link($ec);  
 #       push(@$html,"<br>$kegg_link<br>\n");  
 #    }  
684  }  }
685    
686    
# Line 654  Line 689 
689    
690    
691  sub print_similarities {  sub print_similarities {
692      my( $fig, $cgi, $html, $peg ) = @_;      my( $fig_or_sprout, $cgi, $html, $peg ) = @_;
693      my( $maxN, $maxP, $expand_groups, $ex_checked );      my( $maxN, $maxP, $expand_groups, $ex_checked );
694    
695      my $user = $cgi->param('user') || "";      my $user = $cgi->param('user') || "";
696      my $current_func = &trans_function_of($cgi,$fig,$peg,$user);      my $current_func = &trans_function_of($cgi,$fig_or_sprout,$peg,$user);
697    
698      $maxN = defined( $cgi->param('maxN') ) ? $cgi->param('maxN') : 5;      $maxN = defined( $cgi->param('maxN') ) ? $cgi->param('maxN') : 5;
699      $maxP = defined( $cgi->param('maxP') ) ? $cgi->param('maxP') : 1.0e-5;      $maxP = defined( $cgi->param('maxP') ) ? $cgi->param('maxP') : 1.0e-5;
# Line 690  Line 725 
725      my ( $prev, $next ) = ( 0, 0 );      my ( $prev, $next ) = ( 0, 0 );
726      my ( $prefix, $protnum ) = $peg =~ /^(.*\.)(\d+)$/;      my ( $prefix, $protnum ) = $peg =~ /^(.*\.)(\d+)$/;
727      if ( $prefix && $protnum ) {      if ( $prefix && $protnum ) {
728          $prev = ( $protnum > 1 ) && $fig->translatable( $prefix . ($protnum-1) );          $prev = ( $protnum > 1 ) && &translatable($fig_or_sprout, $prefix . ($protnum-1) );
729          $next =                     $fig->translatable( $prefix . ($protnum+1) );          $next =                     &translatable($fig_or_sprout, $prefix . ($protnum+1) );
730      }      }
731    
732      push(@$html, $cgi->start_form(-action => "protein.cgi#Similarities"));      push(@$html, $cgi->start_form(-action => "protein.cgi#Similarities"));
# Line 701  Line 736 
736          push(@$html,$cgi->hidden(-name => 'translate', -value => 1));          push(@$html,$cgi->hidden(-name => 'translate', -value => 1));
737      }      }
738    
739        my $sprout = $cgi->param('SPROUT') ? 1 : "";
740      push(@$html, $cgi->hidden(-name => 'prot', -value => $peg),      push(@$html, $cgi->hidden(-name => 'prot', -value => $peg),
741                     $cgi->hidden(-name => 'SPROUT', -value => $sprout),
742                   $cgi->hidden(-name => 'sims', -value => 1),                   $cgi->hidden(-name => 'sims', -value => 1),
743                   $cgi->hidden(-name => 'fid',  -value => $peg),                   $cgi->hidden(-name => 'fid',  -value => $peg),
744                   $cgi->hidden(-name => 'user', -value => $user),                   $cgi->hidden(-name => 'user', -value => $user),
# Line 722  Line 759 
759      push( @$html, $cgi->hr );      push( @$html, $cgi->hr );
760    
761      my $select = $just_fig ? "fig" : "all";      my $select = $just_fig ? "fig" : "all";
762      my @sims = $fig->sims( $peg, $maxN, $maxP, $select, $max_expand );      my @sims = &sims($fig_or_sprout, $peg, $maxN, $maxP, $select, $max_expand );
763    
764      if (@sims)      if (@sims)
765      {      {
# Line 732  Line 769 
769                                       -values => ["",$peg,map { $_->id2 } @sims]);                                       -values => ["",$peg,map { $_->id2 } @sims]);
770    
771          my $target = "window$$";          my $target = "window$$";
772            my $sprout = $cgi->param('SPROUT') ? 1 : "";
773          # RAE: added a name to the form so tha the javascript works          # RAE: added a name to the form so tha the javascript works
774          push( @$html, $cgi->start_form( -method => 'post',          push( @$html, $cgi->start_form( -method => 'post',
775                                          -target => $target,                                          -target => $target,
776                                          -action => 'fid_checked.cgi',                                          -action => 'fid_checked.cgi',
777                                          -name   => 'fid_checked'                                          -name   => 'fid_checked'
778                                        ),                                        ),
779                          $cgi->hidden(-name => 'SPROUT', -value => $sprout),
780                        $cgi->hidden(-name => 'fid', -value => $peg),                        $cgi->hidden(-name => 'fid', -value => $peg),
781                        $cgi->hidden(-name => 'user', -value => $user),                        $cgi->hidden(-name => 'user', -value => $user),
782                        $cgi->br,                        $cgi->br,
# Line 862  Line 901 
901                  shift @from;                  shift @from;
902                  next;                  next;
903              }              }
904              my $cbox = $fig->translatable($id2) ?              my $cbox = &translatable($fig_or_sprout,$id2) ?
905                         qq(<input type=checkbox name=checked value="$id2">) : "";                         qq(<input type=checkbox name=checked value="$id2">) : "";
906    
907              my( $family, $sz, $funcF, $fam_link );              my( $family, $sz, $funcF, $fam_link );
908              if ($expand_groups && ($id2 =~ /^fig\|/) && ($family = $fig->in_family($id2)))              if ($expand_groups && ($id2 =~ /^fig\|/) && ($family = &in_family($fig_or_sprout,$id2)))
909              {              {
910                  $sz       = $fig->sz_family($family);                  $sz       = &sz_family($fig_or_sprout,$family);
911                  $funcF    = html_enc( $fig->family_function($family) );                  $funcF    = html_enc( &family_function($fig_or_sprout,$family) );
912                  $fam_link = scalar &HTML::family_link( $family, $user );                  $fam_link = scalar &HTML::family_link( $family, $user );
913              }              }
914              else              else
# Line 880  Line 919 
919              my $id2_link = &HTML::set_prot_links($cgi,$id2);              my $id2_link = &HTML::set_prot_links($cgi,$id2);
920              chomp $id2_link;              chomp $id2_link;
921    
922              my @in_sub  = $fig->peg_to_subsystems($id2);              my @in_sub  = &peg_to_subsystems($fig_or_sprout,$id2);
923              my $in_sub;              my $in_sub;
924              if (@in_sub > 0)              if (@in_sub > 0)
925              {              {
# Line 906  Line 945 
945              my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";              my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";
946              my $color2  = match_color( $b2, $e2, $ln2 );              my $color2  = match_color( $b2, $e2, $ln2 );
947              my $radio   = $user ? shift @from : undef;              my $radio   = $user ? shift @from : undef;
948              my $func2   = html_enc( scalar &trans_function_of( $cgi, $fig, $id2, $user ) );              my $func2   = html_enc( scalar &trans_function_of( $cgi, $fig_or_sprout, $id2, $user ) );
949              ## RAE Added color3. This will color function tables that do not match the original              ## RAE Added color3. This will color function tables that do not match the original
950              ## annotation. This makes is a lot easier to see what is different (e.g. caps/spaces, etc)              ## annotation. This makes is a lot easier to see what is different (e.g. caps/spaces, etc)
951              my $color3="#FFFFFF";              my $color3="#FFFFFF";
# Line 917  Line 956 
956              #              #
957              # Colorize organisms:              # Colorize organisms:
958              #              #
959              # my $org     = html_enc( $fig->org_of( $id2 ) );              # my $org     = html_enc( &org_of($fig_or_sprout, $id2 ) );
960              my ($org,$oc) = $fig->org_and_color_of( $id2 );              my ($org,$oc) = &org_and_color_of($fig_or_sprout, $id2 );
961              $org        = html_enc( $org );              $org        = html_enc( $org );
962    
963              my $aliases = $alia ? html_enc( join( ", ", $fig->feature_aliases($id2) ) )              my $aliases = $alia ? html_enc( join( ", ", &feature_aliasesL($fig_or_sprout,$id2) ) )
964                                  : undef;                                  : undef;
965    
966              #  Okay, everything is calculated, let's "print" the row datum-by-datum:              #  Okay, everything is calculated, let's "print" the row datum-by-datum:
# Line 1032  Line 1071 
1071  ################# Context on the Chromosome ############################  ################# Context on the Chromosome ############################
1072    
1073  sub print_context {  sub print_context {
1074      my($fig,$cgi,$html,$peg,$feat,$beg,$end) = @_;      my($fig_or_sprout,$cgi,$html,$peg,$feat,$beg,$end) = @_;
1075      my($contig1,$beg1,$end1,$strand,$max_so_far,$gap,$comment,$fc,$aliases);      my($contig1,$beg1,$end1,$strand,$max_so_far,$gap,$comment,$fc,$aliases);
1076      my($why_related,$fid1,$sz,$color,$map,$gg,$n,$link,$in_neighborhood);      my($why_related,$fid1,$sz,$color,$map,$gg,$n,$link,$in_neighborhood);
1077    
1078    
1079      my $user = $cgi->param('user');      my $user = $cgi->param('user');
1080      push(@$html,$cgi->start_form(-action => &FIG::cgi_url . "/chromosomal_clusters.cgi"),      my $sprout = $cgi->param('SPROUT') ? 1 : "";
1081        push(@$html,$cgi->start_form(-action => &cgi_url . "/chromosomal_clusters.cgi"),
1082                    $cgi->hidden(-name => 'SPROUT', -value => $sprout),
1083                  $cgi->hidden(-name => "prot", -value => $peg),                  $cgi->hidden(-name => "prot", -value => $peg),
1084                  $cgi->hidden(-name => "uni", -value => 1),                  $cgi->hidden(-name => "uni", -value => 1),
1085                  $cgi->hidden(-name => "user", -value => $user));                  $cgi->hidden(-name => "user", -value => $user));
1086    
1087      $why_related = "";      $why_related = "";
1088      my %in_cluster = map { $_ => 1 } $fig->in_cluster_with($peg);;      my %in_cluster = map { $_ => 1 } &in_cluster_with($fig_or_sprout,$peg);
1089    
1090      my $col_hdrs = ["fid","starts","ends","size","","gap","req.<br>in<br>pin","fc","neigh","comment","aliases","Related"];      my $col_hdrs = ["fid","starts","ends","size","","gap","req.<br>in<br>pin","fc","neigh","comment","aliases","Related"];
1091      my($tab) = [];      my($tab) = [];
1092      my $genes = [];      my $genes = [];
1093    
1094      my $peg_function = &trans_function_of($cgi,$fig,$peg,$user);      my $peg_function = &trans_function_of($cgi,$fig_or_sprout,$peg,$user);
1095    
1096      my($role,$role1,%related_roles);      my($role,$role1,%related_roles);
1097      foreach $role (&FIG::roles_of_function($peg_function))      foreach $role (&roles_of_function($peg_function))
1098      {      {
1099          foreach $role1 ($fig->neighborhood_of_role($role))          foreach $role1 (&neighborhood_of_role($fig_or_sprout,$role))
1100          {          {
1101              $related_roles{$role1} = 1;              $related_roles{$role1} = 1;
1102          }          }
# Line 1064  Line 1105 
1105      foreach $fid1 (@$feat)      foreach $fid1 (@$feat)
1106      {      {
1107          $fc = $in_cluster{$fid1} ? &pin_link($cgi,$fid1) : "";          $fc = $in_cluster{$fid1} ? &pin_link($cgi,$fid1) : "";
1108          my $aliases = join( ', ', $fig->feature_aliases($fid1) );          my $aliases = join( ', ', &feature_aliasesL($fig_or_sprout,$fid1) );
1109          ($contig1,$beg1,$end1) = $fig->boundaries_of(scalar $fig->feature_location($fid1));;          ($contig1,$beg1,$end1) = &boundaries_of($fig_or_sprout,&feature_locationS($fig_or_sprout,$fid1));;
1110          $strand = ($beg1 < $end1) ? "+" : "-";          $strand = ($beg1 < $end1) ? "+" : "-";
1111    
1112          my $function = $fig->function_of($fid1);          my $function = &function_ofS($fig_or_sprout,$fid1);
1113          my $uniprot;          my $uniprot;
1114          if ($aliases =~ /(uni[^,]+)/) {          if ($aliases =~ /(uni[^,]+)/) {
1115               # print STDERR "$1\n";               # print STDERR "$1\n";
# Line 1097  Line 1138 
1138              $link = "";              $link = "";
1139          }          }
1140    
1141          push(@$genes,[&FIG::min($beg1,$end1),&FIG::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]);
1142          if ($max_so_far)          if ($max_so_far)
1143          {          {
1144              $gap = (&FIG::min($beg1,$end1) - $max_so_far) - 1;              $gap = (&min($beg1,$end1) - $max_so_far) - 1;
1145          }          }
1146          else          else
1147          {          {
1148              $gap = "";              $gap = "";
1149          }          }
1150          $max_so_far = &FIG::max($beg1,$end1);          $max_so_far = &max($beg1,$end1);
1151    
1152    
1153          $in_neighborhood = "";          $in_neighborhood = "";
1154          if (&FIG::ftype($fid1) eq "peg")          if (&ftype($fid1) eq "peg")
1155          {          {
1156              $comment = &trans_function_of($cgi,$fig,$fid1,$user);              $comment = &trans_function_of($cgi,$fig_or_sprout,$fid1,$user);
1157              foreach $role (&FIG::roles_of_function($comment))              foreach $role (&roles_of_function($comment))
1158              {              {
1159                  if ($related_roles{$role})                  if ($related_roles{$role})
1160                  {                  {
# Line 1125  Line 1166 
1166          {          {
1167              $comment = "";              $comment = "";
1168          }          }
1169          $comment = &set_map_links($fig,&FIG::genome_of($fid1),$comment);          $comment = &set_map_links($fig_or_sprout,&genome_of($fid1),$comment);
1170          if ($fid1 eq $peg)          if ($fid1 eq $peg)
1171          {          {
1172              $comment = "\@bgcolor=\"#00FF00\":$comment";              $comment = "\@bgcolor=\"#00FF00\":$comment";
# Line 1143  Line 1184 
1184                      $fc,$in_neighborhood,                      $fc,$in_neighborhood,
1185                      $comment,&HTML::set_prot_links($cgi,$aliases),$why_related]);                      $comment,&HTML::set_prot_links($cgi,$aliases),$why_related]);
1186      }      }
     $map = ["",$beg,$end,$genes];  
     $gg = [$map];  
1187      push(@$html,&HTML::make_table($col_hdrs,$tab,"Context on contig $contig1"));      push(@$html,&HTML::make_table($col_hdrs,$tab,"Context on contig $contig1"));
1188      push(@$html,$cgi->br,$cgi->submit('pin with checked genes'),$cgi->end_form,$cgi->br);      push(@$html,$cgi->br,$cgi->submit('pin with checked genes'),$cgi->end_form,$cgi->br);
1189        return ($beg,$end,$genes);
1190    }
1191    
1192    sub print_graphics_context {
1193        my($beg,$end,$genes,$html) = @_;
1194    
1195        my $map = ["",$beg,$end,$genes];
1196        my $gg = [$map];
1197      push(@$html,@{ &GenoGraphics::render($gg,700,4,0,1) });      push(@$html,@{ &GenoGraphics::render($gg,700,4,0,1) });
1198      return;      return;
1199  }  }
# Line 1173  Line 1220 
1220      my $user = $cgi->param('user');      my $user = $cgi->param('user');
1221      $user = defined($user) ? $user : "";      $user = defined($user) ? $user : "";
1222    
1223      my $cluster_url  = "chromosomal_clusters.cgi?prot=$peg&user=$user&uni=1";      my $sprout = $cgi->param('SPROUT') ? 1 : "";
1224        my $cluster_url  = "chromosomal_clusters.cgi?prot=$peg&user=$user&uni=1&SPROUT=$sprout";
1225      my $cluster_link = "<a href=\"$cluster_url\">*</a>";      my $cluster_link = "<a href=\"$cluster_url\">*</a>";
1226      return $cluster_link;      return $cluster_link;
1227  }  }
1228    
1229  sub set_map_links {  sub set_map_links {
1230      my($fig,$org,$func) = @_;      my($fig_or_sprout,$org,$func) = @_;
1231    
1232      if ($func =~ /^(.*)(\d+\.\d+\.\d+\.\d+)(.*)$/)      if ($func =~ /^(.*)(\d+\.\d+\.\d+\.\d+)(.*)$/)
1233      {      {
1234          my $before = $1;          my $before = $1;
1235          my $ec     = $2;          my $ec     = $2;
1236          my $after  = $3;          my $after  = $3;
1237          return &set_map_links($fig,$org,$before) . &set_ec_to_maps($fig,$org,$ec) . &set_map_links($fig,$org,$after);          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);
1238      }      }
1239      return $func;      return $func;
1240  }  }
1241    
1242  sub set_ec_to_maps {  sub set_ec_to_maps {
1243      my($fig,$org,$ec) = @_;      my($fig_or_sprout,$org,$ec) = @_;
1244    
1245      my @maps = $fig->ec_to_maps($ec);      my @maps = &ec_to_maps($fig_or_sprout,$ec);
1246      if (@maps > 0)      if (@maps > 0)
1247      {      {
1248          $cgi->delete('request');          $cgi->delete('request');
# Line 1206  Line 1254 
1254  }  }
1255    
1256  sub show_ec_to_maps {  sub show_ec_to_maps {
1257      my($fig,$cgi,$html,$ec) = @_;      my($fig_or_sprout,$cgi,$html,$ec) = @_;
1258    
1259      my $ec = $cgi->param('ec');      my $ec = $cgi->param('ec');
1260      if (! $ec)      if (! $ec)
# Line 1215  Line 1263 
1263          return;          return;
1264      }      }
1265    
1266      my @maps = $fig->ec_to_maps($ec);      my @maps = &ec_to_maps($fig_or_sprout,$ec);
1267      if (@maps > 0)      if (@maps > 0)
1268      {      {
1269          my $col_hdrs = ["map","metabolic topic"];          my $col_hdrs = ["map","metabolic topic"];
1270          my $map;          my $map;
1271          my $tab      = [map { $map = $_; [&map_link($cgi,$map),$fig->map_name($map)] } @maps];          my $tab      = [map { $map = $_; [&map_link($cgi,$map),&map_name($fig_or_sprout,$map)] } @maps];
1272          push(@$html,&HTML::make_table($col_hdrs,$tab,"$ec: " . $fig->ec_name($ec)));          push(@$html,&HTML::make_table($col_hdrs,$tab,"$ec: " . &ec_name($fig_or_sprout,$ec)));
1273      }      }
1274  }  }
1275    
# Line 1235  Line 1283 
1283  }  }
1284    
1285  sub link_to_map {  sub link_to_map {
1286      my($fig,$cgi,$html) = @_;      my($fig_or_sprout,$cgi,$html) = @_;
1287    
1288      my $map = $cgi->param('map');      my $map = $cgi->param('map');
1289      if (! $map)      if (! $map)
# Line 1261  Line 1309 
1309  }  }
1310    
1311  sub aa_sequence {  sub aa_sequence {
1312      my($fig,$cgi,$html,$prot) = @_;      my($fig_or_sprout,$cgi,$html,$prot) = @_;
1313      my($seq,$func,$i);      my($seq,$func,$i);
1314    
1315      unshift @$html, "<TITLE>The SEED: Protein Sequence</TITLE>\n";      unshift @$html, "<TITLE>The SEED: Protein Sequence</TITLE>\n";
1316      if ($seq = $fig->get_translation($prot))      if ($seq = &get_translation($fig_or_sprout,$prot))
1317      {      {
1318          $func = $fig->function_of($prot,$cgi->param('user'));          $func = &function_ofS($fig_or_sprout,$prot,$cgi->param('user'));
1319          push(@$html,$cgi->pre,">$prot $func\n");          push(@$html,$cgi->pre,">$prot $func\n");
1320          for ($i=0; ($i < length($seq)); $i += 60)          for ($i=0; ($i < length($seq)); $i += 60)
1321          {          {
# Line 1289  Line 1337 
1337  }  }
1338    
1339  sub dna_sequence {  sub dna_sequence {
1340      my($fig,$cgi,$html,$fid) = @_;      my($fig_or_sprout,$cgi,$html,$fid) = @_;
1341      my($seq,$func,$i);      my($seq,$func,$i);
1342    
1343      unshift @$html, "<TITLE>The SEED: Nucleotide Sequence</TITLE>\n";      unshift @$html, "<TITLE>The SEED: Nucleotide Sequence</TITLE>\n";
1344      if ($seq = $fig->dna_seq($fig->genome_of($fid),scalar $fig->feature_location($fid)))      if ($seq = &dna_seq($fig_or_sprout,&genome_of($fid),&feature_locationS($fig_or_sprout,$fid)))
1345      {      {
1346          $func = $fig->function_of($prot,$cgi->param('user'));          $func = &function_ofS($fig_or_sprout,$prot,$cgi->param('user'));
1347          push(@$html,$cgi->pre,">$fid $func\n");          push(@$html,$cgi->pre,">$fid $func\n");
1348          for ($i=0; ($i < length($seq)); $i += 60)          for ($i=0; ($i < length($seq)); $i += 60)
1349          {          {
# Line 1317  Line 1365 
1365  }  }
1366    
1367  sub show_fusions {  sub show_fusions {
1368      my($fig,$cgi,$html,$prot) = @_;      my($fig_or_sprout,$cgi,$html,$prot) = @_;
1369    
1370      my $user = $cgi->param('user');      my $user = $cgi->param('user');
1371      $user = $user ? $user : "";      $user = $user ? $user : "";
1372        my $sprout = $cgi->param('SPROUT') ? 1 : "";
1373    
1374      $ENV{"REQUEST_METHOD"} = "GET";      $ENV{"REQUEST_METHOD"} = "GET";
1375      $ENV{"QUERY_STRING"} = "peg=$prot&user=$user";      $ENV{"QUERY_STRING"} = "peg=$prot&user=$user&SPROUT=$sprout";
1376      my @out = `./fusions.cgi`;      my @out = `./fusions.cgi`;
1377      print join("",@out);      print join("",@out);
1378      exit;      exit;
1379  }  }
1380    
1381    ###########################################################################
1382  sub print_compared_regions {  sub print_compared_regions {
1383      my($fig,$cgi,$html,$peg) = @_;      my($fig_or_sprout,$cgi,$html,$peg) = @_;
1384    
1385        my $sz_region = $cgi->param('sz_region');
1386        $sz_region = $sz_region ? $sz_region : 16000;
1387    
1388      my @closest_pegs = &closest_pegs($fig,$peg,5);      my $num_close = $cgi->param('num_close');
1389        $num_close = $num_close ? $num_close : 5;
1390    
1391        my @closest_pegs = &closest_pegs($fig_or_sprout,$peg,$num_close);
1392    
1393      if (@closest_pegs > 0)      if (@closest_pegs > 0)
1394      {      {
1395          if ($fig->possibly_truncated($peg))          if (&possibly_truncated($fig_or_sprout,$peg))
1396          {          {
1397              push(@closest_pegs,&possible_extensions($peg,\@closest_pegs));              push(@closest_pegs,&possible_extensions($peg,\@closest_pegs));
1398          }          }
1399          @closest_pegs = $fig->sort_fids_by_taxonomy(@closest_pegs);          @closest_pegs = &sort_fids_by_taxonomy($fig_or_sprout,@closest_pegs);
1400          unshift(@closest_pegs,$peg);          unshift(@closest_pegs,$peg);
1401          my @all_pegs = ();          my @all_pegs = ();
1402          my $gg = &build_maps($fig,\@closest_pegs,\@all_pegs);          my $gg = &build_maps($fig_or_sprout,\@closest_pegs,\@all_pegs,$sz_region);
1403  #warn Dumper($gg);  #warn Dumper($gg);
1404          my $color_sets = &cluster_genes(\@all_pegs,$peg);          my $color_sets = &cluster_genes(\@all_pegs,$peg);
1405          &set_colors_text_and_links($gg,\@all_pegs,$color_sets);          &set_colors_text_and_links($gg,\@all_pegs,$color_sets);
1406          ################################### add commentary capability          ################################### add commentary capability
1407    
1408            my @parm_reset_form = ($cgi->hr);
1409            push(@parm_reset_form,$cgi->start_form(-action => &cgi_url . "/protein.cgi" ));
1410            my $param;
1411            foreach $param ($cgi->param())
1412            {
1413                next if (($param eq "sz_region") || ($param eq "num_close"));
1414                push(@parm_reset_form,$cgi->hidden(-name => $param, -value => $cgi->param($param)));
1415            }
1416            push(@parm_reset_form,
1417                       "size region: ",
1418                       $cgi->textfield(-name => 'sz_region', -size =>  10, -value => $sz_region, -override => 1),
1419                       "&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; ",
1420                       "Number close genomes: ",
1421                       $cgi->textfield(-name => 'num_close', -size => 4, -value => $num_close, -override => 1),
1422                       $cgi->br,
1423                       $cgi->submit('Reset Parameters')
1424                 );
1425            push(@parm_reset_form,$cgi->end_form);
1426            push(@$html,@parm_reset_form);
1427    ####
1428          my @commentary_form = ();          my @commentary_form = ();
1429          my $ctarget = "window$$";          my $ctarget = "window$$";
1430          my $user = $cgi->param('user');          my $user = $cgi->param('user');
1431            my $sprout = $cgi->param('SPROUT') ? 1 : "";
1432    
1433          push(@commentary_form,$cgi->start_form(-target => $ctarget,          push(@commentary_form,$cgi->start_form(-target => $ctarget,
1434                                                 -action => &FIG::cgi_url . "/chromosomal_clusters.cgi"                                                 -action => &cgi_url . "/chromosomal_clusters.cgi"
1435                                                 ));                                                 ));
1436          push(@commentary_form,$cgi->hidden(-name => "request", -value => "show_commentary"));  
1437            push(@commentary_form,$cgi->hidden(-name => 'SPROUT', -value => $sprout),
1438                                  $cgi->hidden(-name => "request", -value => "show_commentary"));
1439          push(@commentary_form,$cgi->hidden(-name => "prot", -value => $peg));          push(@commentary_form,$cgi->hidden(-name => "prot", -value => $peg));
1440          push(@commentary_form,$cgi->hidden(-name => "uni", -value => 1));          push(@commentary_form,$cgi->hidden(-name => "uni", -value => 1));
1441          push(@commentary_form,$cgi->hidden(-name => "user", -value => $user));          push(@commentary_form,$cgi->hidden(-name => "user", -value => $user));
# Line 1411  Line 1492 
1492  }  }
1493    
1494  sub closest_pegs {  sub closest_pegs {
1495      my($fig,$peg,$n) = @_;      my($fig_or_sprout,$peg,$n) = @_;
1496      my($id2,$d,$peg2,$i);      my($id2,$d,$peg2,$i);
1497    
1498      my @closest = map { $id2 = $_->id2; ($id2 =~ /^fig\|/) ? $id2 : () } $fig->sims($peg,5,1.0e-20,"all");      my @closest = map { $id2 = $_->id2; ($id2 =~ /^fig\|/) ? $id2 : () } &sims($fig_or_sprout,$peg,5,1.0e-20,"all");
1499    
1500      if (@closest > $n) { $#closest = $n-1 }      if (@closest > $n) { $#closest = $n-1 }
1501      my %closest = map { $_ => 1 } @closest;      my %closest = map { $_ => 1 } @closest;
1502      my @pinned_to = grep { $_ ne $peg} $fig->in_pch_pin_with($peg);      my @pinned_to = grep { $_ ne $peg} &in_pch_pin_with($fig_or_sprout,$peg);
1503      my $g1 = &FIG::genome_of($peg);      my $g1 = &genome_of($peg);
1504      @pinned_to =      @pinned_to =
1505          map {$_->[1] }          map {$_->[1] }
1506          sort { $a->[0] <=> $b->[0] }          sort { $a->[0] <=> $b->[0] }
1507          map { $peg2 = $_; $d = $fig->crude_estimate_of_distance($g1,&FIG::genome_of($peg2)); [$d,$peg2] }          map { $peg2 = $_; $d = &crude_estimate_of_distance($fig_or_sprout,$g1,&genome_of($peg2)); [$d,$peg2] }
1508          @pinned_to;          @pinned_to;
1509    
1510      for ($i=0; ($i < @pinned_to) && ($i < $n); $i++)      for ($i=0; ($i < @pinned_to) && ($i < $n); $i++)
# Line 1434  Line 1515 
1515  }  }
1516    
1517  sub build_maps {  sub build_maps {
1518      my($fig,$pinned_pegs,$all_pegs) = @_;      my($fig_or_sprout,$pinned_pegs,$all_pegs,$sz_region) = @_;
1519      my($gg,$loc,$contig,$beg,$end,$mid,$min,$max,$genes,$feat,$fid);      my($gg,$loc,$contig,$beg,$end,$mid,$min,$max,$genes,$feat,$fid);
1520      my($contig1,$beg1,$end1,$map,$peg);      my($contig1,$beg1,$end1,$map,$peg);
1521    
1522      $gg = [];      $gg = [];
1523      foreach $peg (@$pinned_pegs)      foreach $peg (@$pinned_pegs)
1524      {      {
1525          $loc = $fig->feature_location($peg);          $loc = &feature_locationS($fig_or_sprout,$peg);
1526          ($contig,$beg,$end) = &FIG::boundaries_of($loc);          ($contig,$beg,$end) = &boundaries_of($fig_or_sprout,$loc);
1527          if ($contig && $beg && $end)          if ($contig && $beg && $end)
1528          {          {
1529              $mid = int(($beg + $end) / 2);              $mid = int(($beg + $end) / 2);
1530              $min = $mid - 8000;              $min = int($mid - ($sz_region / 2));
1531              $max = $mid + 8000;              $max = int($mid + ($sz_region / 2));
1532              $genes = [];              $genes = [];
1533              ($feat,undef,undef) = $fig->genes_in_region(&FIG::genome_of($peg),$contig,$min,$max);              ($feat,undef,undef) = &genes_in_region($fig_or_sprout,&genome_of($peg),$contig,$min,$max);
1534              foreach $fid (@$feat)              foreach $fid (@$feat)
1535              {              {
1536                  ($contig1,$beg1,$end1) = &FIG::boundaries_of(scalar $fig->feature_location($fid));                  ($contig1,$beg1,$end1) = &boundaries_of($fig_or_sprout,&feature_locationS($fig_or_sprout,$fid));
1537                  $beg1 = &in_bounds($min,$max,$beg1);                  $beg1 = &in_bounds($min,$max,$beg1);
1538                  $end1 = &in_bounds($min,$max,$end1);                  $end1 = &in_bounds($min,$max,$end1);
1539                  my $aliases = join( ', ', $fig->feature_aliases($fid) );                  my $aliases = join( ', ', &feature_aliasesL($fig_or_sprout,$fid) );
1540                  my $function = $fig->function_of($fid);                  my $function = &function_ofS($fig_or_sprout,$fid);
1541                  my $uniprot;                  my $uniprot;
1542                  if ($aliases =~ /(uni[^,]+)/) {                  if ($aliases =~ /(uni[^,]+)/) {
1543                      $uniprot = $1;                      $uniprot = $1;
1544                  }                  }
1545                  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 : '');                  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 : '');
                 my $fmg = join ('<br/>', "<a href=\&quot;protein.cgi?compare_region=1\&amp;prot=$fid\&amp;user=\&quot;>show</a>",  
                                         "<a href=\&quot#\&quot; onClick=\&quot;setValue('bound1', '$fid'); return false;\&quot;>set bound 1</a>",  
                                         "<a href=\&quot#\&quot; onClick=\&quot;setValue('bound2', '$fid'); return false;\&quot;>set bound 2</a>",  
                                         "<a href=\&quot#\&quot; onClick=\&quot;setValue('candidates', '$fid'); return false;\&quot;>set candidate</a>");  
1546    
1547                  push(@$genes,[&FIG::min($beg1,$end1),                  my $sprout = $cgi->param('SPROUT') ? 1 : "";
1548                                &FIG::max($beg1,$end1),                  my $fmg = join ('<br/>', "<a href=\&quot;protein.cgi?SPROUT=$sprout&compare_region=1\&prot=$fid\&user=\&quot>show</a>",
1549                                            "<a onClick=\&quot;setValue('bound1', '$fid'); return false;\&quot;>set bound 1</a>",
1550                                            "<a onClick=\&quot;setValue('bound2', '$fid'); return false;\&quot;>set bound 2</a>",
1551                                            "<a onClick=\&quot;setValue('candidates', '$fid'); return false;\&quot;>set candidate</a>");
1552    
1553                    push(@$genes,[&min($beg1,$end1),
1554                                  &max($beg1,$end1),
1555                                ($beg1 < $end1) ? "rightArrow" : "leftArrow",                                ($beg1 < $end1) ? "rightArrow" : "leftArrow",
1556                                "grey",                                "grey",
1557                                "",                                "",
# Line 1480  Line 1563 
1563                      push(@$all_pegs,$fid);                      push(@$all_pegs,$fid);
1564                  }                  }
1565              }              }
1566              $map = [&FIG::abbrev($fig->org_of($peg)),0,$max+1-$min,              $map = [&abbrev(&org_of($fig_or_sprout,$peg)),0,$max+1-$min,
1567                      ($beg < $end) ? &decr_coords($genes,$min) : &flip_map($genes,$min,$max)];                      ($beg < $end) ? &decr_coords($genes,$min) : &flip_map($genes,$min,$max)];
1568              push(@$gg,$map);              push(@$gg,$map);
1569          }          }
# Line 1600  Line 1683 
1683    
1684      for ($i=0; ($i < @$all_pegs); $i++)      for ($i=0; ($i < @$all_pegs); $i++)
1685      {      {
1686          $tmp = $fig->maps_to_id($all_pegs->[$i]);          $tmp = &maps_to_id($fig_or_sprout,$all_pegs->[$i]);
1687          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
1688          if ($tmp ne $all_pegs->[$i])          if ($tmp ne $all_pegs->[$i])
1689          {          {
# Line 1623  Line 1706 
1706    
1707      for ($i=0; ($i < @$all_pegs); $i++)      for ($i=0; ($i < @$all_pegs); $i++)
1708      {      {
1709          foreach $sim ($fig->sims($all_pegs->[$i],500,1.0e-5,"raw"))          foreach $sim (&sims($fig_or_sprout,$all_pegs->[$i],500,1.0e-5,"raw"))
1710          {          {
1711              if (defined($x = $pos_of{$sim->id2}))              if (defined($x = $pos_of{$sim->id2}))
1712              {              {
# Line 1672  Line 1755 
1755      my($peg,$closest_pegs) = @_;      my($peg,$closest_pegs) = @_;
1756      my($g,$sim,$id2,$peg1,%poss);      my($g,$sim,$id2,$peg1,%poss);
1757    
1758      $g = &FIG::genome_of($peg);      $g = &genome_of($peg);
1759    
1760      foreach $peg1 (@$closest_pegs)      foreach $peg1 (@$closest_pegs)
1761      {      {
1762          if ($g ne &FIG::genome_of($peg1))          if ($g ne &genome_of($peg1))
1763          {          {
1764              foreach $sim ($fig->sims($peg1,500,1.0e-5,"all"))              foreach $sim (&sims($fig_or_sprout,$peg1,500,1.0e-5,"all"))
1765              {              {
1766                  $id2 = $sim->id2;                  $id2 = $sim->id2;
1767                  if (($id2 ne $peg) && ($id2 =~ /^fig\|$g\./) && $fig->possibly_truncated($id2))                  if (($id2 ne $peg) && ($id2 =~ /^fig\|$g\./) && &possibly_truncated($fig_or_sprout,$id2))
1768                  {                  {
1769                      $poss{$id2} = 1;                      $poss{$id2} = 1;
1770                  }                  }
# Line 1690  Line 1773 
1773      }      }
1774      return keys(%poss);      return keys(%poss);
1775  }  }
1776    
1777    sub display_page {
1778        my($fig_or_sprout,$cgi,$html) = @_;
1779    
1780        if (ref($html) eq "ARRAY")
1781        {
1782            &HTML::show_page($cgi,$html);
1783        }
1784        else
1785        {
1786            if ($cgi->param('SPROUT'))
1787            {
1788                &HTML::BuildPage($html);
1789            }
1790            else
1791            {
1792                my $gathered = [];
1793    
1794                my $section;
1795                foreach $section (qw( javascript
1796                                      general
1797                                      translate_status
1798                                      contig_context
1799                                      context_graphic
1800                                      subsys_connections
1801                                      assgn_for_equiv_prots
1802                                      links
1803                                      services
1804                                      kv_pairs
1805                                      compare_region
1806                                      similarities
1807                                      tools
1808                                      )
1809                                  )
1810                {
1811                    if (@{$html->{$section}} > 0)
1812                    {
1813                        push(@$gathered,@{$html->{$section}});
1814                        push(@$gathered,$cgi->hr);
1815                    }
1816                }
1817                pop @$gathered;
1818                &HTML::show_page($cgi,$gathered);
1819            }
1820        }
1821    }
1822    
1823    sub show_html_followed_by_initial {
1824        my($fig_or_sprout,$cgi,$html,$prot) = @_;
1825    
1826        my %html = ( general               => [],
1827                     contig_context        => [],
1828                     context_graphic       => [],
1829                     subsys_connections    => [],
1830                     links                 => [],
1831                     services              => [],
1832                     translate_status      => [],
1833                     tools                 => [],
1834                     kv_pairs              => [],
1835                     similarities          => [],
1836                     assgn_for_equiv_prots => [],
1837                     javascript            => [],
1838                     compare_region        => []
1839                   );
1840    
1841        push(@{$html{general}},@$html);
1842        $html = \%html;
1843        &show_initial($fig_or_sprout,$cgi,$html,$prot);
1844        return $html;
1845    }
1846    
1847    sub translation_piece {
1848        my($fig_or_sprout,$cgi,$html) = @_;
1849    
1850        my $msg;
1851        my $url = $cgi->self_url();
1852        if ($cgi->param('translate')) {
1853            $url =~ s/[;&]translate(=[^;&])?//i or $url =~ s/translate(=[^;&])?[;&]//i;
1854            $msg = "Turn Off Function Translation";
1855        }
1856        else
1857        {
1858            $url .= ";translate=1";
1859            $msg = "Translate Function Assignments";
1860        }
1861        push(@$html, "<a href=\"$url\">$msg</a><br>\n");
1862    }
1863    
1864    
1865    #######################################################################################
1866    
1867    sub by_alias {
1868        my($fig_or_sprout,$prot) = @_;
1869        return $fig_or_sprout->by_alias($prot);
1870    }
1871    
1872    sub org_of {
1873        my($fig_or_sprout,$prot) = @_;
1874    
1875        return $fig_or_sprout->org_of($prot);
1876    }
1877    
1878    sub is_real_feature {
1879        my($fig_or_sprout,$prot) = @_;
1880    
1881        return $fig_or_sprout->is_real_feature($prot);
1882    }
1883    
1884    sub coupling_and_evidence {
1885        my($fig_or_sprout,$peg,$bound,$sim_cutoff,$coupling_cutoff) = @_;
1886    
1887        return $fig_or_sprout->coupling_and_evidence($peg,$bound,$sim_cutoff,$coupling_cutoff,"keep");
1888    }
1889    
1890    sub feature_locationS {
1891        my($fig_or_sprout,$peg) = @_;
1892    
1893        return scalar $fig_or_sprout->feature_location($peg);
1894    }
1895    
1896    sub boundaries_of {
1897        my($fig_or_sprout,$loc) = @_;
1898    
1899        return $fig_or_sprout->boundaries_of($loc);
1900    }
1901    
1902    
1903    sub in_cluster_with {
1904        my($fig_or_sprout,$peg) = @_;
1905    
1906        return $fig_or_sprout->in_cluster_with($peg);
1907    }
1908    
1909    sub neighborhood_of_role {
1910        my($fig_or_sprout,$role) = @_;
1911    
1912        return $fig_or_sprout->neighborhood_of_role($role);
1913    }
1914    
1915    sub feature_aliasesL {
1916        my($fig_or_sprout,$fid) = @_;
1917    
1918        my @tmp = $fig_or_sprout->feature_aliases($fid);
1919        return @tmp;
1920    }
1921    
1922    sub feature_aliasesS {
1923        my($fig_or_sprout,$fid) = @_;
1924    
1925        return scalar $fig_or_sprout->feature_aliases($fid);
1926    }
1927    
1928    sub function_ofL {
1929        my($fig_or_sprout,$peg) = @_;
1930    
1931        my @tmp = $fig_or_sprout->function_of($peg);
1932        return @tmp;
1933    }
1934    
1935    sub function_ofS {
1936        my($fig_or_sprout,$peg) = @_;
1937    
1938        return scalar $fig_or_sprout->function_of($peg);
1939    }
1940    
1941    sub mapped_prot_ids {
1942        my($fig_or_sprout,$peg) = @_;
1943    
1944        return $fig_or_sprout->mapped_prot_ids($peg);
1945    }
1946    
1947    sub peg_links {
1948        my($fig_or_sprout,$peg) = @_;
1949    
1950        return $fig_or_sprout->peg_links($peg);
1951    }
1952    
1953    sub get_translation {
1954        my($fig_or_sprout,$prot) = @_;
1955    
1956        return $fig_or_sprout->get_translation($prot);
1957    }
1958    
1959    sub assign_function {
1960        my($fig_or_sprout,$prot,$who,$function) = @_;
1961    
1962        $fig_or_sprout->assign_function($prot,$who,$function,"");
1963    }
1964    
1965    sub add_annotation {
1966        my($fig_or_sprout,$prot,$user,$annotation) = @_;
1967    
1968        $fig_or_sprout->add_annotation($prot,$user,$annotation);
1969    }
1970    
1971    sub feature_annotations {
1972        my($fig_or_sprout,$prot) = @_;
1973    
1974        return $fig_or_sprout->feature_annotations($prot);
1975    }
1976    
1977    sub related_by_func_sim {
1978        my($fig_or_sprout,$peg,$user) = @_;
1979    
1980        return $fig_or_sprout->related_by_func_sim($peg,$user);
1981    }
1982    
1983    sub merged_related_annotations {
1984        my($fig_or_sprout,$related) = @_;
1985    
1986        return $fig_or_sprout->merged_related_annotations($related);
1987    }
1988    
1989    sub genus_species {
1990        my($fig_or_sprout,$genome) = @_;
1991    
1992        return $fig_or_sprout->genus_species($genome);
1993    }
1994    
1995    sub genes_in_region {
1996        my($fig_or_sprout,$genome,$contig,$min,$max) = @_;
1997    
1998        return $fig_or_sprout->genes_in_region($genome,$contig,$min,$max);
1999    }
2000    
2001    sub translate_function {
2002        my($fig_or_sprout,$func) = @_;
2003    
2004        return $fig_or_sprout->translate_function($func);
2005    }
2006    
2007    sub feature_attributes {
2008        my($fig_or_sprout,$peg) = @_;
2009    
2010        return $fig_or_sprout->feature_attributes($peg);
2011    }
2012    
2013    sub subsystems_for_peg {
2014        my($fig_or_sprout,$peg) = @_;
2015    
2016        return $fig_or_sprout->subsystems_for_peg($peg);
2017    }
2018    
2019    sub sims {
2020        my($fig_or_sprout,$peg,$max,$cutoff,$select,$expand) = @_;
2021    
2022        return $fig_or_sprout->sims($peg,$max,$cutoff,$select,$expand);
2023    }
2024    
2025    sub in_family {
2026        my($fig_or_sprout,$id) = @_;
2027    
2028        return $fig_or_sprout->in_family($id);
2029    }
2030    
2031    sub sz_family {
2032        my($fig_or_sprout,$family) = @_;
2033    
2034        return $fig_or_sprout->sz_family($family);
2035    }
2036    
2037    sub peg_to_subsystems {
2038        my($fig_or_sprout,$id) = @_;
2039    
2040        return $fig_or_sprout->peg_to_subsystems($id);
2041    }
2042    
2043    sub org_and_color_of {
2044        my($fig_or_sprout,$id) = @_;
2045    
2046        return $fig_or_sprout->org_and_color_of($id);
2047    }
2048    
2049    sub ec_to_maps {
2050        my($fig_or_sprout,$ec) = @_;
2051    
2052        return $fig_or_sprout->ec_to_maps($ec);
2053    }
2054    
2055    sub map_name {
2056        my($fig_or_sprout,$map) = @_;
2057    
2058        return $fig_or_sprout->map_name($map);
2059    }
2060    
2061    sub ec_name {
2062        my($fig_or_sprout,$ec) = @_;
2063    
2064        return $fig_or_sprout->ec_name($ec);
2065    }
2066    
2067    sub dna_seq {
2068        my($fig_or_sprout,$genome,$loc) = @_;
2069    
2070        return $fig_or_sprout->dna_seq($genome,$loc);
2071    }
2072    
2073    sub possibly_truncated {
2074        my($fig_or_sprout,$id) = @_;
2075    
2076        return $fig_or_sprout->possibly_truncated($id);
2077    }
2078    
2079    sub sort_fids_by_taxonomy {
2080        my($fig_or_sprout,@fids) = @_;
2081    
2082        return $fig_or_sprout->sort_fids_by_taxonomy(@fids);
2083    }
2084    
2085    sub in_pch_pin_with {
2086        my($fig_or_sprout,$peg) = @_;
2087    
2088        return $fig_or_sprout->in_pch_pin_with($peg);
2089    }
2090    
2091    sub crude_estimate_of_distance {
2092        my($fig_or_sprout,$genome1,$genome2) = @_;
2093    
2094        return $fig_or_sprout->crude_estimate_of_distance($genome1,$genome2);
2095    }
2096    
2097    sub maps_to_id {
2098        my($fig_or_sprout,$peg) = @_;
2099    
2100        return $fig_or_sprout->maps_to_id($peg);
2101    }
2102    
2103    sub translatable {
2104        my($fig_or_sprout,$peg) = @_;
2105    
2106        return $fig_or_sprout->translatable($peg);
2107    }
2108    
2109    sub cgi_url {
2110        return &FIG::plug_url($FIG_Config::cgi_url);
2111    }
2112    
2113    
2114    
2115    ###########################################################
2116    
2117    sub genome_of {
2118        my $prot_id = (@_ == 1) ? $_[0] : $_[1];
2119    
2120        if ($prot_id =~ /^fig\|(\d+\.\d+)/) { return $1; }
2121        return undef;
2122    }
2123    
2124    sub min {
2125        my(@x) = @_;
2126        my($min,$i);
2127    
2128        (@x > 0) || return undef;
2129        $min = $x[0];
2130        for ($i=1; ($i < @x); $i++)
2131        {
2132            $min = ($min > $x[$i]) ? $x[$i] : $min;
2133        }
2134        return $min;
2135    }
2136    
2137    sub max {
2138        my(@x) = @_;
2139        my($max,$i);
2140    
2141        (@x > 0) || return undef;
2142        $max = $x[0];
2143        for ($i=1; ($i < @x); $i++)
2144        {
2145            $max = ($max < $x[$i]) ? $x[$i] : $max;
2146        }
2147        return $max;
2148    }
2149    
2150    
2151    sub roles_of_function {
2152        my $func = (@_ == 1) ? $_[0] : $_[1];
2153    
2154        return (split(/\s*[\/;]\s+/,$func),($func =~ /\d+\.\d+\.\d+\.\d+/g));
2155    }
2156    
2157    sub ftype {
2158        my($feature_id) = @_;
2159    
2160        if ($feature_id =~ /^fig\|\d+\.\d+\.([^\.]+)/)
2161        {
2162            return $1;
2163        }
2164        return undef;
2165    }
2166    
2167    sub abbrev {
2168        my($genome_name) = @_;
2169    
2170        $genome_name =~ s/^(\S{3})\S+/$1./;
2171        $genome_name =~ s/^(\S+\s+\S{4})\S+/$1./;
2172        if (length($genome_name) > 13)
2173        {
2174            $genome_name = substr($genome_name,0,13);
2175        }
2176        return $genome_name;
2177    }
2178    

Legend:
Removed from v.1.52  
changed lines
  Added in v.1.53

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3