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

Diff of /FigWebServices/feature.cgi

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

revision 1.1, Tue Oct 5 21:38:57 2004 UTC revision 1.2, Wed Oct 6 20:25:24 2004 UTC
# Line 37  Line 37 
37  }  }
38    
39  my $html = [];  my $html = [];
40  unshift @$html, "<TITLE>The SEED Protein Page</TITLE>\n";  unshift @$html, "<TITLE>The SEED Feature Page</TITLE>\n";
41    
42  my $feature = $cgi->param('feature');  my $feature = $cgi->param('feature');
43  if (! $feature)  if (! $feature)
# Line 63  Line 63 
63      }      }
64  }  }
65    
66    #my $request = $cgi->param("request") || "";
67  #  #
68  #  Allow previous and next actions in calls to the script -- GJO  #if ($request eq "view_annotations")       { &view_annotations($fig,$cgi,$html,$feature); }
69  #  #elsif ($request eq "view_all_annotations")   { &view_all_annotations($fig,$cgi,$html,$feature); }
70    #elsif ($request eq "dna_sequence")           { &dna_sequence($fig,$cgi,$html,$feature); }
71    #else                                         { &show_initial($fig,$cgi,$html,$feature); }
72    
73  #my $adjust = $cgi->param('previous PEG') ? -1 : $cgi->param('next PEG') ? 1 : 0;  &show_initial($fig,$cgi,$html,$feature);
 #if ( $adjust ) {  
 #    my ( $prefix, $protnum ) = $prot =~ /^(.*\.)(\d+)$/;  
 #    if ( $prefix && $protnum ) {  
 #        my $prot2 = $prefix . ($protnum + $adjust);  
 #        if ( $fig->translatable( $prot2 ) ) {  
 #            $prot = $prot2;  
 #            $cgi->delete('prot');  
 #            $cgi->param(-name => 'prot', -value => $prot);  
 #        }  
 #    }  
 #    ( $adjust < 0 ) && $cgi->delete('previous PEG');  
 #    ( $adjust > 0 ) && $cgi->delete('next PEG');  
 #}  
 #  
 my $request = $cgi->param("request") || "";  
   
 if ($request eq "view_annotations")       { &view_annotations($fig,$cgi,$html,$feature); }  
 elsif ($request eq "view_all_annotations")   { &view_all_annotations($fig,$cgi,$html,$feature); }  
 elsif ($request eq "aa_sequence")            { &aa_sequence($fig,$cgi,$html,$feature); }  
 elsif ($request eq "dna_sequence")           { &dna_sequence($fig,$cgi,$html,$feature); }  
 else                                         { &show_initial($fig,$cgi,$html,$feature); }  
74    
75  &HTML::show_page($cgi,$html);  &HTML::show_page($cgi,$html);
76  exit;  exit;
77    
 #==============================================================================  
 #  use_protein_tool  
 #==============================================================================  
   
 sub use_protein_tool {  
     my($fig,$cgi,$html,$prot) = @_;  
     my($url,$method,@args,$line,$name,$val);  
   
     my $seq = $fig->get_translation($prot);  
     if (! $seq)  
     {  
         unshift @$html, "<TITLE>The SEED: Protein Page</TITLE>\n";  
         push(@$html,$cgi->h1("Sorry, $prot does not have a translation"));  
         return;  
     }  
     my $protQ = quotemeta $prot;  
   
     my $tool = $cgi->param('tool');  
     $/ = "\n//\n";  
     my @tools = grep { $_ =~ /^$tool\n/ } `cat $FIG_Config::global/LinksToTools`;  
     if (@tools == 1)  
     {  
         chomp $tools[0];  
         (undef,undef,$url,$method,@args) = split(/\n/,$tools[0]);  
         my $args = [];  
         foreach $line (@args)  
         {  
             ($name,$val) = split(/\t/,$line);  
             $val =~ s/FIGID/$prot/;  
             $val =~ s/FIGSEQ/$seq/;  
             $val =~ s/\\n/\n/g;  
             push(@$args,[$name,$val]);  
         }  
         unshift @$html, "<TITLE>The SEED: Protein Tool</TITLE>\n";  
         push(@$html,&HTML::get_html($url,$method,$args));  
     }  
 }  
   
 #==============================================================================  
 #  make_assignment  
 #==============================================================================  
   
 sub make_assignment {  
     my($fig,$cgi,$html,$prot) = @_;  
     my($userR);  
   
     my $function = $cgi->param('func');  
     my $user     = $cgi->param('user');  
   
     if ($function && $user && $prot)  
     {  
         if ($user =~ /master:(.*)/)  
         {  
             $userR = $1;  
             $fig->assign_function($prot,"master",$function,"");  
             $fig->add_annotation($prot,$userR,"Set master function to\n$function\n");  
         }  
         else  
         {  
             $fig->assign_function($prot,$user,$function,"");  
             $fig->add_annotation($prot,$user,"Set function to\n$function\n");  
         }  
     }  
     $cgi->delete("request");  
     $cgi->delete("func");  
     &show_initial($fig,$cgi,$html,$prot);  
 }  
78    
79  #==============================================================================  #==============================================================================
80  #  view_annotations  #  view_annotations
81  #==============================================================================  #==============================================================================
82    
83  sub view_annotations {  sub view_annotations {
84      my($fig,$cgi,$html,$prot) = @_;      my($fig,$cgi,$html,$feature) = @_;
85    
86      unshift @$html, "<TITLE>The SEED: Protein Annotations</TITLE>\n";      unshift @$html, "<TITLE>The SEED: eature Annotations</TITLE>\n";
87      my $col_hdrs = ["who","when","annotation"];      my $col_hdrs = ["who","when","annotation"];
88      my $tab = [ map { [$_->[2],$_->[1],"<pre>" . $_->[3] . "<\/pre>"] } $fig->feature_annotations($prot) ];      my $tab = [ map { [$_->[2],$_->[1],"<pre>" . $_->[3] . "<\/pre>"] } $fig->feature_annotations($feature) ];
89      if (@$tab > 0)      if (@$tab > 0)
90      {      {
91          push(@$html,&HTML::make_table($col_hdrs,$tab,"Annotations for $prot"));          push(@$html,&HTML::make_table($col_hdrs,$tab,"Annotations for $feature"));
92      }      }
93      else      else
94      {      {
95          push(@$html,"<h1>No Annotations for $prot</h1>\n");          push(@$html,"<h1>No Annotations for $feature</h1>\n");
96      }      }
97  }  }
98    
# Line 210  Line 125 
125      }      }
126  }  }
127    
 #==============================================================================  
 #  show_coupling_evidence  
 #==============================================================================  
   
 sub show_coupling_evidence {  
     my($fig,$cgi,$html,$peg) = @_;  
     my($pair,$peg1,$peg2,$link1,$link2);  
   
     unshift @$html, "<TITLE>The SEED: Functional Coupling</TITLE>\n";  
     my $user = $cgi->param('user');  
     my $to   = $cgi->param('to');  
     my @coup = grep { $_->[1] eq $to } $fig->coupling_and_evidence($peg,5000,1.0e-10,4,"keep");  
   
     if (@coup != 1)  
     {  
         push(@$html,"<h1>Sorry, no evidence that $peg is coupled to $to</h1>\n");  
     }  
     else  
     {  
         my $col_hdrs = ["Peg1","Organism1","Function1","Peg2","Organism2","Function2"];  
         my $tab = [];  
         foreach $pair (@{$coup[0]->[2]})  
         {  
             ($peg1,$peg2) = @$pair;  
             $link1 = &HTML::fid_link($cgi,$peg1);  
             $link2 = &HTML::fid_link($cgi,$peg2);  
             push( @$tab, [ $link1,  
                            $fig->org_of($peg1),  
                            scalar $fig->function_of($peg1,$user),  
                            $link2,  
                            $fig->org_of($peg2),  
                            scalar $fig->function_of($peg2,$user)  
                          ]  
                 );  
         }  
         push(@$html,&HTML::make_table($col_hdrs,$tab,"Evidence that $peg Is Coupled To $to"));  
     }  
 }  
   
 #==============================================================================  
 #  psi_blast_prot_sequence  
 #==============================================================================  
   
 sub psi_blast_prot_sequence {  
     my($fig,$cgi,$prot_id) = @_;  
 }  
128    
129  #==============================================================================  #==============================================================================
130  #  show_initial  #  show_initial
131  #==============================================================================  #==============================================================================
132    
133  sub show_initial {  sub show_initial {
134      my($fig,$cgi,$html,$prot) = @_;      my($fig,$cgi,$html,$feature) = @_;
135    
136      unshift @$html, "<TITLE>The SEED: Protein Page</TITLE>\n";      unshift @$html, "<TITLE>The SEED: Feature Page</TITLE>\n";
137      my $gs = $fig->org_of($prot);      my $gs = $fig->org_of($feature);
138      if ($prot =~ /^fig\|\d+\.\d+\.peg/)      if ($feature =~ /^fig\|\d+\.\d+\.peg/)
139      {      {
140          if (! $fig->is_real_feature($prot))          if (! $fig->is_real_feature($feature))
141          {          {
142              push(@$html,"<h1>Sorry, $prot is an unknown identifier</h1>\n");              push(@$html,"<h1>Sorry, $feature is an unknown identifier</h1>\n");
143          }          }
144          else          else
145          {          {
146              push(@$html,"<h1>Protein $prot: $gs</h1>\n");              push(@$html,"<h1>Feature $feature: $gs</h1>\n");
147              my $msg;              my $msg;
148              my $url = $cgi->self_url();              my $url = $cgi->self_url();
149              if ($cgi->param('translate')) {              if ($cgi->param('translate')) {
# Line 286  Line 155 
155                  $url .= ";translate=1";                  $url .= ";translate=1";
156                  $msg = "Translate Function Assignments";                  $msg = "Translate Function Assignments";
157              }              }
158              push(@$html, "<a href=\"$url\">$msg</a><br>\n");              #push(@$html, "<a href=\"$url\">$msg</a><br>\n");
159    
160              &display_peg($fig,$cgi,$html,$prot);              &display_peg($fig,$cgi,$html,$feature);
161          }          }
162      }      }
163      else      else
164      {      {
165  #       &display_external($fig,$cgi,$html,$prot);          &display_external($fig,$cgi,$html,$feature);
166      }      }
167  }  }
168    
# Line 306  Line 175 
175      my $loc;      my $loc;
176    
177      my $half_sz = 5000;      my $half_sz = 5000;
     my $fc = $cgi->param('fc');  
     my @fc_data;  
     if ($fc)  
     {  
         @fc_data = $fig->coupling_and_evidence($peg,5000,1.0e-10,4,"keep");  
     }  
     else  
     {  
         @fc_data = ();  
     }  
178    
179      if ($loc = $fig->feature_location($peg))      if ($loc = $fig->feature_location($peg))
180      {      {
# Line 327  Line 186 
186          &print_context($fig,$cgi,$html,$peg,$feat,$min,$max);          &print_context($fig,$cgi,$html,$peg,$feat,$min,$max);
187      }      }
188    
189      &print_assignments($fig,$cgi,$html,$peg);      #&print_assignments($fig,$cgi,$html,$peg);
   
     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");  
   
     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)))  
     {  
         my $link = $cgi->self_url() . "&fc=1";  
         push(@$html,"<br><a href=$link>To Get Detailed Functional Coupling Data</a>\n");  
     }  
     elsif ($fc)  
     {  
         &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");  
   
     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);  
     }  
   
     my $sims = $cgi->param('sims');  
     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;  
   
         push( @$html, $cgi->start_form(-action => "protein.cgi#Similarities"));  
         if ($cgi->param('translate'))  
         {  
             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);  
     }  
   
     if ($has_translation)  
     {  
         &show_tools($fig,$cgi,$html,$peg);  
     }  
 }  
   
 ################# Table-Driven Show Tools  ############################  
   
 sub show_tools {  
     my($fig,$cgi,$html,$peg) = @_;  
   
     $cgi->param(-name => "request",  
                 -value => "use_protein_tool");  
     my $url = $cgi->self_url();  
   
     if (open(TMP,"<$FIG_Config::global/LinksToTools"))  
     {  
         push(@$html,$cgi->hr);  
         my $col_hdrs = ["Tool","Description"];  
         my $tab = [];  
   
         $/ = "\n//\n";  
         while (defined($_ = <TMP>))  
         {  
             my($tool,$desc) = split(/\n/,$_);  
             push(@$tab,["<a href=\"$url\&tool=$tool\">$tool</a>",$desc]);  
         }  
         close(TMP);  
         $/ = "\n";  
         push(@$html,&HTML::make_table($col_hdrs,$tab,"Tools to Analyze Protein Sequences"));  
     }  
     $cgi->delete('request');  
 }  
   
 ################# Functional Coupling  ############################  
   
 sub print_fc {  
     my($fig,$cgi,$html,$peg,$fc_data) = @_;  
     my($sc,$neigh);  
   
     my $user  = $cgi->param('user');  
     my @tab   = map { ($sc,$neigh) = @$_;  
                       [&ev_link($cgi,$neigh,$sc),$neigh,scalar $fig->function_of($neigh,$user)]  
                     }  
                     @$fc_data;  
     if (@tab > 0)  
     {  
         push(@$html,"<hr>\n");  
         my $col_hdrs = ["Score","Peg","Function"];  
         push(@$html,&HTML::make_table($col_hdrs,\@tab,"Functional Coupling"));  
     }  
 }  
   
 sub ev_link {  
     my($cgi,$neigh,$sc) = @_;  
   
     my $prot = $cgi->param('prot');  
     my $link = $cgi->url() . "?request=show_coupling_evidence&prot=$prot&to=$neigh";  
     return "<a href=$link>$sc</a>";  
 }  
   
 ################# Assignments  ############################  
   
 sub trans_function_of {  
     my($cgi,$fig,$peg,$user) = @_;  
   
     if (wantarray())  
     {  
         my $x;  
         my @funcs = $fig->function_of($peg);  
         if ($cgi->param('translate'))  
         {  
             @funcs = map { $x = $_; $x->[1] = $fig->translate_function($x->[1]); $x } @funcs;  
         }  
         return @funcs;  
     }  
     else  
     {  
         my $func = $fig->function_of($peg,$user);  
         if ($cgi->param('translate'))  
         {  
             $func = $fig->translate_function($func);  
         }  
         return $func;  
     }  
 }  
   
 sub print_assignments {  
     my($fig,$cgi,$html,$peg) = @_;  
     my($who,$func,$ec,@ecs,@tmp,$id,$i,$master_func,$user_func,$x);  
   
     my $user = $cgi->param('user');  
     my @funcs    = map { [$peg,@$_] } &trans_function_of($cgi,$fig,$peg);  
   
     for ($i=0; ($i < @funcs) && ($funcs[$i]->[1] ne "master"); $i++) {}  
     if ($i < @funcs)  
     {  
         $master_func = $funcs[$i]->[2];  
     }  
     else  
     {  
         $master_func = "";  
     }  
   
     for ($i=0; ($i < @funcs) && ($funcs[$i]->[1] ne $user); $i++) {}  
     if ($i < @funcs)  
     {  
         $user_func = $funcs[$i]->[2];  
     }  
     else  
     {  
         $user_func = $master_func;  
     }  
     push(@$html,$cgi->h2("Current Assignment: $peg: $user_func"));  
     my @maps_to  = grep { $_ ne $peg } map { $_->[0] } $fig->mapped_prot_ids($peg);  
     @funcs = ();  
     foreach $id (@maps_to)  
     {  
         if (($id ne $peg) && (@tmp = &trans_function_of($cgi,$fig,$id)) && (@tmp > 0))  
         {  
             push(@funcs, map { $x = $_; [$id,@$_] } @tmp);  
         }  
     }  
     @funcs = map { ($_->[1] eq "master") ? [$_->[0],"",$_->[2]] : $_ } @funcs;  
     push(@$html,"<hr>\n");  
   
     if ((@funcs == 0) && (! $user_func))  
     {  
         push(@$html,$cgi->h1("No function has been assigned"));  
     }  
   
     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 ];  
     if (@$tab > 0)  
     {  
         my $col_hdrs = ["Id","Organism","Who","ASSIGN","Assignment"];  
         my $title    = "Assignments for Essentially Identical Proteins";  
         push(@$html,&HTML::make_table($col_hdrs,$tab,$title));  
     }  
   
   
   
     my @attr = $fig->feature_attributes($peg);  
     if (@attr > 0)  
     {  
         my $tab = [];  
         foreach $_ (@attr)  
         {  
             my($tag,$val,$url) = @$_;  
             push(@$tab,[$tag,"<a href=\"$url\">$val</a>"]);  
         }  
         push(@$html,$cgi->br,$cgi->hr,&HTML::make_table(["Key","Value"],$tab,"Attributes"),$cgi->hr);  
     }  
   
     #  
     # Show the subsystems in which this protein participates.  
     #  
   
     if (my @subsystems = $fig->subsystems_for_peg($peg))  
     {  
         push(@$html,  
              $cgi->hr,  
              $cgi->h2("Subsystems in which this peg is present"));  
   
         my(@hdrs);  
         my(@table);  
   
         @hdrs = ("Subsystem", "Role");  
   
         for my $ent (@subsystems)  
         {  
             my($sub, $role) = @$ent;  
             my $url = $cgi->a({href => "ssa2.cgi?user=$user&ssa_name=$sub&request=show_ssa"}, $sub);  
             push(@table, [$url, $role]);  
         }  
         push(@$html, &HTML::make_table(\@hdrs, \@table));  
     }  
   
     push(@$html,$cgi->hr);  
   
190      my @links = $fig->peg_links($peg);      my @links = $fig->peg_links($peg);
191      if (@links > 0)      if (@links > 0)
192      {      {
# Line 605  Line 201 
201          }          }
202          push(@$html,&HTML::make_table($col_hdrs,$tab,$title));          push(@$html,&HTML::make_table($col_hdrs,$tab,$title));
203      }      }
   
     my $url = &FIG::cgi_url . "/add_links.cgi?peg=$peg";  
     push(@$html,"<a href=$url>To Add New Links to this Gene</a>\n");  
   
 #    $_ = 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");  
 #    }  
 }  
   
   
   
 ################# Similarities  ############################  
   
   
 sub print_similarities {  
     my( $fig, $cgi, $html, $peg ) = @_;  
     my( $maxN, $maxP, $expand_groups, $ex_checked );  
   
     my $user = $cgi->param('user') || "";  
     my $current_func = &trans_function_of($cgi,$fig,$peg,$user);  
   
     $maxN = defined( $cgi->param('maxN') ) ? $cgi->param('maxN') : 5;  
     $maxP = defined( $cgi->param('maxP') ) ? $cgi->param('maxP') : 1.0e-5;  
     $expand_groups = $cgi->param('expand_groups');  
     $ex_checked = $expand_groups ? "checked" : "";  
   
     my $max_expand = $cgi->param('max_expand') || 0;  
     my $just_fig   = $cgi->param('just_fig')   || 0;  
     my $show_env   = $cgi->param('show_env')   || 0;  
     my $hide_alias = $cgi->param('hide_alias') || 0;  
   
     push( @$html, $cgi->hr,  
                   "<a name=Similarities>",  
                   $cgi->h1('Similarities'),  
                   "</a>\n"  
         );  
   
     #  
     #  Instead of automatically doubling maxN, use the value of  
     #  $cgi->param("more similarities") to drive increase in maxN and  
     #  max_expand  
     #  
     if ( $cgi->param('more similarities') ) {  
         $maxN       *= 2;  
         $max_expand *= 2;  
         $cgi->delete('more similarities');  
     }  
   
     my ( $prev, $next ) = ( 0, 0 );  
     my ( $prefix, $protnum ) = $peg =~ /^(.*\.)(\d+)$/;  
     if ( $prefix && $protnum ) {  
         $prev = ( $protnum > 1 ) && $fig->translatable( $prefix . ($protnum-1) );  
         $next =                     $fig->translatable( $prefix . ($protnum+1) );  
     }  
   
     push(@$html, $cgi->start_form(-action => "protein.cgi#Similarities"),  
                  $cgi->hidden(-name => 'prot', -value => $peg),  
                  $cgi->hidden(-name => 'sims', -value => 1),  
                  $cgi->hidden(-name => 'fid',  -value => $peg),  
                  $cgi->hidden(-name => 'user', -value => $user),  
                  " 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->br,  
                  $prev ? $cgi->submit('previous PEG') : (),  
                  $cgi->submit('resubmit'),  
                  $cgi->submit('more similarities'),  
                  $next ? $cgi->submit('next PEG') : (),  
                  $cgi->end_form  
          );  
   
204      push( @$html, $cgi->hr );      push( @$html, $cgi->hr );
205        my $link1 = $cgi->self_url() . "&request=view_annotations";
206        my $link2 = $cgi->self_url() . "&request=view_all_annotations";
207        push(@$html,"<br><a href=$link1>To View Annotations</a>/<a href=$link2>To View All Related Annotations</a>\n");
208    
     my $select = $just_fig ? "fig" : "all";  
     my @sims = $fig->sims( $peg, $maxN, $maxP, $select, $max_expand );  
   
     if (@sims)  
     {  
         my @from = $cgi->radio_group(-name => 'from',  
                                      -nolabels => 1,  
                                      -override => 1,  
                                      -values => ["",$peg,map { $_->id2 } @sims]);  
   
         my $target = "window$$";  
         # RAE: added a name to the form so tha the javascript works  
         push( @$html, $cgi->start_form( -method => 'post',  
                                         -target => $target,  
                                         -action => 'fid_checked.cgi',  
                                         -name   => 'fid_checked'  
                                       ),  
                       $cgi->hidden(-name => 'fid', -value => $peg),  
                       $cgi->hidden(-name => 'user', -value => $user),  
                       $cgi->br,  
                       "For Selected (checked) sequences: ",  
                            $cgi->submit('align'),  
                            $cgi->submit('view annotations'),  
                            $cgi->submit('show regions')  
             );  
   
         if ($user)  
         {   my $help_url = "Html/help_for_assignments_and_rules.html";  
             push ( @$html, $cgi->br, $cgi->br,  
                            "<a href=$help_url>Help on Assignments, Rules, and Checkboxes</a>",  
                            $cgi->br, $cgi->br,  
                            $cgi->submit('assign/annotate')  
                  );  
   
             if ($cgi->param('translate'))  
             {  
                 push( @$html, $cgi->submit('add rules'),  
                               $cgi->submit('check rules'),  
                               $cgi->br  
                     );  
             }  
         }  
   
         push( @$html, $cgi->br,  
                       $cgi->checkbox( -name    => 'checked',  
                                       -value   => $peg,  
                                       -override => 1,  
                                       -checked => 1,  
                                       -label   => ""  
                                     )  
             );  
   
         my $col_hdrs;  
         my $color_help = "(<A href=\"Html/similarity_region_colors.html\">colors explained</A>)";  
         if ($user && $cgi->param('translate'))  
         {  
             push( @$html, " ASSIGN to/Translate from/SELECT current PEG", $cgi->br,  
                           "ASSIGN/annotate with form: ", shift @from, $cgi->br,  
                           "ASSIGN from/Translate to current PEG: ", shift @from  
                 );  
             $col_hdrs = [ "ASSIGN to<hr>Translate from",  
                           $expand_groups ? "family" : (),  
                           $expand_groups ? "size" : (),  
                           "Similar sequence",  
                           "E-val<br>% iden",  
                           "region in<br>similar sequence<br>$color_help",  
                           "region in<br>$peg<br>$color_help",  
                           "ASSIGN from<hr>Translate to",  
                           "Function",  
                           "Organism",  
                           ! $hide_alias ? "Aliases" : ()  
                         ];  
         }  
         elsif ($user)  
         {  
             push( @$html, " ASSIGN to/SELECT current PEG", $cgi->br,  
                           "ASSIGN/annotate with form: ", shift @from, $cgi->br,  
                           "ASSIGN from current PEG: ", shift @from  
                 );  
             $col_hdrs = [ "ASSIGN to<hr>SELECT",  
                           $expand_groups ? "family" : (),  
                           $expand_groups ? "size" : (),  
                           "Similar sequence",  
                           "E-val<br>% iden",  
                           "region in<br>similar sequence<br>$color_help",  
                           "region in<br>$peg<br>$color_help",  
                           "ASSIGN from",  
                           "Function",  
                           "Organism",  
                           ! $hide_alias ? "Aliases" : ()  
                         ];  
         }  
         else  
         {  
             push(@$html, " SELECT current PEG", $cgi->br );  
             $col_hdrs = [ "SELECT",  
                           $expand_groups ? "family" : (),  
                           $expand_groups ? "size" : (),  
                           "Similar sequence",  
                           "E-val<br>% iden",  
                           "region in<br>similar sequence<br>$color_help",  
                           "region in<br>$peg<br>$color_help",  
                           "Function",  
                           "Organism",  
                           ! $hide_alias ? "Aliases" : ()  
                         ];  
         }  
   
         # RAE Add the check all/uncheck all boxes.  
         push (@$html, $cgi->br, &HTML::java_buttons("fid_checked", "checked"), $cgi->br);  
   
   
         #  
         # Total rewrite of sim table code: cleaner program flow; omitting  
         # empty columns; colorizing region-of-similarity cells -- GJO  
         #  
         # Start the similarity table with "Caption" and header row  
   
         my $ncol = @$col_hdrs;  
         push( @$html, "<TABLE border cols=$ncol>\n",  
                       "\t<Caption><h2>Similarities</h2></Caption>\n",  
                       "\t<TR>\n\t\t<TH>",  
                       join( "</TH>\n\t\t<TH>", @$col_hdrs ),  
                       "</TH>\n\t</TR>\n"  
             );  
   
         #  Add the table data, row-by-row  
209    
210          my $alia = ! $hide_alias;      my $link = $cgi->self_url() . "&request=dna_sequence";
211          my $sim;      push(@$html,"<br><a href=$link>DNA Sequence</a>\n");
         foreach $sim ( @sims )  
         {  
             my $id2  = $sim->id2;  
             if ((! $show_env) && ($id2 =~ /^fig\|99999/))  
             {  
                 shift @from;  
                 next;  
             }  
             my $cbox = $fig->translatable($id2) ?  
                        qq(<input type=checkbox name=checked value="$id2">) : "";  
212    
213              my( $family, $sz, $funcF, $fam_link );      $link = $cgi->url();
214              if ($expand_groups && ($id2 =~ /^fig\|/) && ($family = $fig->in_family($id2)))      $link =~ s/protein.cgi/fid_checked.cgi/;
215        my $user = $cgi->param('user');
216        if (! $user)
217              {              {
218                  $sz       = $fig->sz_family($family);          $user = "";
                 $funcF    = html_enc( $fig->family_function($family) );  
                 $fam_link = scalar &HTML::family_link( $family, $user );  
219              }              }
220              else              else
221              {              {
222                  $family = $sz = $funcF = $fam_link = "";          $link = $link . "?fid=$feature&user=$user&checked=$feature&assign/annotate=assign/annotate";
223              }          push(@$html,"<br><a href=$link target=checked_window>To Make an Annotation</a>\n");
   
             my $id2_link = &HTML::set_prot_links($cgi,$id2);  
             chomp $id2_link;  
             my $psc     = $sim->psc;  
             my $iden    = $sim->iden;  
             my $ln1     = $sim->ln1;  
             my $ln2     = $sim->ln2;  
             my $b1      = $sim->b1;  
             my $e1      = $sim->e1;  
             my $b2      = $sim->b2;  
             my $e2      = $sim->e2;  
             my $d1      = abs($e1 - $b1) + 1;  
             my $d2      = abs($e2 - $b2) + 1;  
             my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";  
             my $color1  = match_color( $b1, $e1, $ln1 );  
             my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";  
             my $color2  = match_color( $b2, $e2, $ln2 );  
             my $radio   = $user ? shift @from : undef;  
             my $func2   = html_enc( scalar &trans_function_of( $cgi, $fig, $id2, $user ) );  
             ## RAE Added color3. This will color function tables that do not match the original  
             ## annotation. This makes is a lot easier to see what is different (e.g. caps/spaces, etc)  
             my $color3="#FFFFFF";  
             unless ($func2 eq $current_func) {$color3="#FFDEAD"}  
   
             if ($funcF && $funcF ne $func2) { $func2 = "$funcF<br>$func2" }  
   
             #  
             # Colorize organisms:  
             #  
             # my $org     = html_enc( $fig->org_of( $id2 ) );  
             my ($org,$oc) = $fig->org_and_color_of( $id2 );  
             $org        = html_enc( $org );  
   
             my $aliases = $alia ? html_enc( join( ", ", $fig->feature_aliases($id2) ) )  
                                 : undef;  
   
             #  Okay, everything is calculated, let's "print" the row datum-by-datum:  
   
             push( @$html, "\t<TR>\n",  
                           #  
                           #  Colorize check box by Domain  
                           #  
                           "\t\t<TD Align=center Bgcolor=$oc>$cbox</TD>\n",  
                           $expand_groups ? "\t\t<TD>$fam_link</TD>/n" : (),  
                           $expand_groups ? "\t\t<TD>$sz</TD>\n" : (),  
                           "\t\t<TD Nowrap>$id2_link</TD>\n",  
                           "\t\t<TD Nowrap>$psc<br>$iden\%</TD>\n",  
                           "\t\t<TD Nowrap Bgcolor=$color2>$reg2</TD>\n",  
                           "\t\t<TD Nowrap Bgcolor=$color1>$reg1</TD>\n",  
                           $user ? "\t\t<TD Align=center>$radio</TD>\n" : (),  
                           "\t\t<TD Bgcolor=$color3>$func2</TD>\n",  
                           #  
                           #  Colorize organism by Domain  
                           #  
                           # "\t\t<TD>$org</TD>\n",  
                           "\t\t<TD Bgcolor=$oc>$org</TD>\n",  
                           $alia ? "\t\t<TD>$aliases</TD>\n" : (),  
                           "\t</TR>\n"  
                 );  
         }  
   
         push( @$html, "</TABLE>\n" );  
         push( @$html, $cgi->end_form );  
     }  
 }  
   
 #  
 #  Support functions for writing the similarities  
 #  
 #  This is a sufficient set of escaping for text in HTML:  
 #  
   
 sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }  
   
 #  
 #  Make a background color that reflects the position and extent of a  
 #  matching region.  
 #  
 #      Left side is red; right side is blue.  
 #      Long match is white or pastel; short match is saturated color.  
 #  
   
 sub match_color {  
     my ( $b, $e, $n ) = @_;  
     my ( $l, $r ) = ( $e > $b ) ? ( $b, $e ) : ( $e, $b );  
     # my $hue = 3/4 * 0.5*($l+$r)/$n - 1/24;  
     my $hue = 5/6 * 0.5*($l+$r)/$n - 1/12;  
     my $cov = ( $r - $l + 1 ) / $n;  
     my $sat = 1 - 10 * $cov / 9;  
     # my $br  = 0.8 + 0.2 * $cov;  
     my $br  = 1;  
     rgb2html( hsb2rgb( $hue, $sat, $br ) );  
224  }  }
225    
226  #      my $has_translation = $fig->translatable($peg);
 #  Convert HSB to RGB.  Hue is taken to be in range 0 - 1 (red to red);  
 #  
227    
 sub hsb2rgb {  
     my ( $h, $s, $br ) = @_;  
     $h = 6 * ($h - floor($h));      # Hue is made cyclic modulo 1  
     if ( $s  > 1 ) { $s  = 1 } elsif ( $s  < 0 ) { $s  = 0 }  
     if ( $br > 1 ) { $br = 1 } elsif ( $br < 0 ) { $br = 0 }  
     my ( $r, $g, $b ) = ( $h <= 3 ) ? ( ( $h <= 1 ) ? ( 1,      $h,     0      )  
                                       : ( $h <= 2 ) ? ( 2 - $h, 1,      0      )  
                                       :               ( 0,      1,      $h - 2 )  
                                       )  
                                     : ( ( $h <= 4 ) ? ( 0,      4 - $h, 1      )  
                                       : ( $h <= 5 ) ? ( $h - 4, 0,      1      )  
                                       :               ( 1,      0,      6 - $h )  
                                       );  
     ( ( $r * $s + 1 - $s ) * $br,  
       ( $g * $s + 1 - $s ) * $br,  
       ( $b * $s + 1 - $s ) * $br  
     )  
 }  
228    
 #  
 #  Convert an RGB value to an HTML color string:  
 #  
   
 sub rgb2html {  
     my ( $r, $g, $b ) = @_;  
     if ( $r > 1 ) { $r = 1 } elsif ( $r < 0 ) { $r = 0 }  
     if ( $g > 1 ) { $g = 1 } elsif ( $g < 0 ) { $g = 0 }  
     if ( $b > 1 ) { $b = 1 } elsif ( $b < 0 ) { $b = 0 }  
     sprintf("\"#%02x%02x%02x\"", int(255.999*$r), int(255.999*$g), int(255.999*$b) )  
229  }  }
230    
 #  
 #  floor could be gotten from POSIX::, but why bother?  
 #  
231    
 sub floor {  
     my $x = $_[0];  
     defined( $x ) || return undef;  
     ( $x >= 0 ) || ( int($x) == $x ) ? int( $x ) : -1 - int( - $x )  
 }  
232    
233    
234  ################# Context on the Chromosome ############################  ################# Context on the Chromosome ############################
235    
236  sub print_context {  sub print_context {
237      my($fig,$cgi,$html,$peg,$feat,$beg,$end) = @_;      my($fig,$cgi,$html,$peg,$feat,$beg,$end) = @_;
238      my($contig1,$beg1,$end1,$strand,$max_so_far,$gap,$comment,$fc,$aliases);      my($contig1,$beg1,$end1,$strand,$max_so_far,$comment, $aliases);
239      my($why_related,$fid1,$sz,$color,$map,$gg,$n,$link,$in_neighborhood);      my($fid1,$sz,$color,$map,$gg,$n,$link);
240    
241    
242      my $user = $cgi->param('user');      my $user = $cgi->param('user');
243      push(@$html,$cgi->start_form(-action => &FIG::cgi_url . "/chromosomal_clusters.cgi"),      push(@$html,$cgi->start_form(-action => &FIG::cgi_url . "/chromosomal_clusters.cgi"),
244                  $cgi->hidden(-name => "prot", -value => $peg),                  $cgi->hidden(-name => "feature", -value => $peg),
245                  $cgi->hidden(-name => "user", -value => $user));                  $cgi->hidden(-name => "user", -value => $user));
246    
247      $why_related = "";      my $col_hdrs = ["fid","starts","ends","size","","comment","aliases"];
     my %in_cluster = map { $_ => 1 } $fig->in_cluster_with($peg);;  
   
     my $col_hdrs = ["fid","starts","ends","size","","gap","req.<br>in<br>pin","fc","neigh","comment","aliases","Related"];  
248      my($tab) = [];      my($tab) = [];
249      my $genes = [];      my $genes = [];
250    
251      my $peg_function = &trans_function_of($cgi,$fig,$peg,$user);      #my $peg_function = &trans_function_of($cgi,$fig,$peg,$user);
252    
253      my($role,$role1,%related_roles);      #my($role,$role1,%related_roles);
254      foreach $role (&FIG::roles_of_function($peg_function))      #foreach $role (&FIG::roles_of_function($peg_function))
255      {      #{
256          foreach $role1 ($fig->neighborhood_of_role($role))  #       foreach $role1 ($fig->neighborhood_of_role($role))
257          {  #       {
258              $related_roles{$role1} = 1;  #           $related_roles{$role1} = 1;
259          }  #       }
260      }  #    }
261    
262      foreach $fid1 (@$feat)      foreach $fid1 (@$feat)
263      {      {
         $fc = $in_cluster{$fid1} ? &pin_link($cgi,$fid1) : "";  
264          $aliases = join( ', ', $fig->feature_aliases($fid1) );          $aliases = join( ', ', $fig->feature_aliases($fid1) );
265          ($contig1,$beg1,$end1) = $fig->boundaries_of(scalar $fig->feature_location($fid1));;          ($contig1,$beg1,$end1) = $fig->boundaries_of(scalar $fig->feature_location($fid1));;
266          $strand = ($beg1 < $end1) ? "+" : "-";          $strand = ($beg1 < $end1) ? "+" : "-";
267    
268          if     ($fid1 eq $peg)    { $color = "green" }          if     ($fid1 eq $peg)    { $color = "green" }
         elsif  ($fc)              { $color = "blue" }  
269          else                      { $color = "red" }          else                      { $color = "red" }
270    
271          if ($fid1 =~ /peg\.(\d+)$/)          if ($fid1 =~ /peg\.(\d+)$/)
272          {          {
273              $n = $1;              $n = $1;
274              $link = $cgi->url() . "?prot=$fid1&user=$user";              $link = $cgi->url() . "?feature=$fid1&user=$user";
275          }          }
276          elsif ($fid1 =~ /\.([a-z]+)\.\d+$/)          elsif ($fid1 =~ /\.([a-z]+)\.\d+$/)
277          {          {
# Line 1036  Line 285 
285          }          }
286    
287          push(@$genes,[&FIG::min($beg1,$end1),&FIG::max($beg1,$end1),($strand eq "+") ? "rightArrow" : "leftArrow", $color,$n,$link]);          push(@$genes,[&FIG::min($beg1,$end1),&FIG::max($beg1,$end1),($strand eq "+") ? "rightArrow" : "leftArrow", $color,$n,$link]);
         if ($max_so_far)  
         {  
             $gap = (&FIG::min($beg1,$end1) - $max_so_far) - 1;  
         }  
         else  
         {  
             $gap = "";  
         }  
288          $max_so_far = &FIG::max($beg1,$end1);          $max_so_far = &FIG::max($beg1,$end1);
289    
290    
         $in_neighborhood = "";  
291          if (&FIG::ftype($fid1) eq "peg")          if (&FIG::ftype($fid1) eq "peg")
292          {          {
293              $comment = &trans_function_of($cgi,$fig,$fid1,$user);              $comment = &trans_function_of($cgi,$fig,$fid1,$user);
             foreach $role (&FIG::roles_of_function($comment))  
             {  
                 if ($related_roles{$role})  
                 {  
                     $in_neighborhood = "*";  
                 }  
             }  
294          }          }
295          else          else
296          {          {
# Line 1070  Line 303 
303          }          }
304          $sz = abs($end1-$beg1)+1;          $sz = abs($end1-$beg1)+1;
305    
306          my $must_have = (($fid1 eq $peg) || (! $fc)) ? "" : $cgi->checkbox(-name => 'must_have',  
307                                                                             -value => $fid1,          push(@$tab,[&HTML::fid_link($cgi,$fid1,"local"),$beg1,$end1,$sz,$strand,
308                                                                             -checked => 0,                      $comment,&HTML::set_prot_links($cgi,$aliases)]);
                                                                            -override => 1,  
                                                                            -label => "");  
   
         push(@$tab,[&HTML::fid_link($cgi,$fid1,"local"),$beg1,$end1,$sz,$strand,$gap,  
                     $must_have,  
                     $fc,$in_neighborhood,  
                     $comment,&HTML::set_prot_links($cgi,$aliases),$why_related]);  
309      }      }
310      $map = ["",$beg,$end,$genes];      $map = ["",$beg,$end,$genes];
311      $gg = [$map];      $gg = [$map];
312      push(@$html,&HTML::make_table($col_hdrs,$tab,"Context on contig $contig1"));      push(@$html,&HTML::make_table($col_hdrs,$tab,"Context on contig $contig1"));
313      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);
314      push(@$html,@{ &GenoGraphics::render($gg,700,4,0,1) });      push(@$html,@{ &GenoGraphics::render($gg,700,4,0,1) });
315      return;      return;
316  }  }
317    
 sub assign_link {  
     my($cgi,$func,$existing_func) = @_;  
     my($assign_url,$assign_link);  
   
     if ($func && ((! $existing_func) || ($existing_func ne $func)))  
     {  
         $cgi->delete('request');  
         $assign_url  = $cgi->self_url() . "&request=fast_assign&func=$func";  ## must encode  
         $assign_link = "<a href=\"$assign_url\">&nbsp;<=&nbsp;</a>";  
     }  
     else  
     {  
         $assign_link = "";  
     }  
     return $assign_link;  
 }  
   
 sub pin_link {  
     my($cgi,$peg) = @_;  
     my $user = $cgi->param('user');  
     $user = defined($user) ? $user : "";  
   
     my $cluster_url  = "chromosomal_clusters.cgi?prot=$peg&user=$user";  
     my $cluster_link = "<a href=\"$cluster_url\">*</a>";  
     return $cluster_link;  
 }  
   
318  sub set_map_links {  sub set_map_links {
319      my($fig,$org,$func) = @_;      my($fig,$org,$func) = @_;
320    
# Line 1198  Line 397 
397      push(@$html,@out);      push(@$html,@out);
398  }  }
399    
 sub aa_sequence {  
     my($fig,$cgi,$html,$prot) = @_;  
     my($seq,$func,$i);  
   
     unshift @$html, "<TITLE>The SEED: Protein Sequence</TITLE>\n";  
     if ($seq = $fig->get_translation($prot))  
     {  
         $func = $fig->function_of($prot,$cgi->param('user'));  
         push(@$html,$cgi->pre,">$prot $func\n");  
         for ($i=0; ($i < length($seq)); $i += 60)  
         {  
             if ($i > (length($seq) - 60))  
             {  
                 push(@$html,substr($seq,$i) . "\n");  
             }  
             else  
             {  
                 push(@$html,substr($seq,$i,60) . "\n");  
             }  
         }  
         push(@$html,$cgi->end_pre);  
     }  
     else  
     {  
         push(@$html,$cgi->h1("No translation available for $prot"));  
     }  
 }  
400    
401  sub dna_sequence {  sub dna_sequence {
402      my($fig,$cgi,$html,$fid) = @_;      my($fig,$cgi,$html,$fid) = @_;
# Line 1233  Line 405 
405      unshift @$html, "<TITLE>The SEED: Nucleotide Sequence</TITLE>\n";      unshift @$html, "<TITLE>The SEED: Nucleotide Sequence</TITLE>\n";
406      if ($seq = $fig->dna_seq($fig->genome_of($fid),scalar $fig->feature_location($fid)))      if ($seq = $fig->dna_seq($fig->genome_of($fid),scalar $fig->feature_location($fid)))
407      {      {
408          $func = $fig->function_of($prot,$cgi->param('user'));          $func = $fig->function_of($feature,$cgi->param('user'));
409          push(@$html,$cgi->pre,">$fid $func\n");          push(@$html,$cgi->pre,">$fid $func\n");
410          for ($i=0; ($i < length($seq)); $i += 60)          for ($i=0; ($i < length($seq)); $i += 60)
411          {          {
# Line 1254  Line 426 
426      }      }
427  }  }
428    
 sub show_fusions {  
     my($fig,$cgi,$html,$prot) = @_;  
   
     my $user = $cgi->param('user');  
     $user = $user ? $user : "";  
     $ENV{"REQUEST_METHOD"} = "GET";  
     $ENV{"QUERY_STRING"} = "peg=$prot&user=$user";  
     my @out = `./fusions.cgi`;  
     print join("",@out);  
     exit;  
 }  
   
 sub print_compared_regions {  
     my($fig,$cgi,$html,$peg) = @_;  
   
     my @closest_pegs = &closest_pegs($fig,$peg,5);  
   
     if (@closest_pegs > 0)  
     {  
         if ($fig->possibly_truncated($peg))  
         {  
             push(@closest_pegs,&possible_extensions($peg,\@closest_pegs));  
         }  
         @closest_pegs = $fig->sort_fids_by_taxonomy(@closest_pegs);  
         unshift(@closest_pegs,$peg);  
         my @all_pegs = ();  
         my $gg = &build_maps($fig,\@closest_pegs,\@all_pegs);  
         my $color_sets = &cluster_genes(\@all_pegs,$peg);  
         &set_colors_text_and_links($gg,\@all_pegs,$color_sets);  
         ################################### add commentary capability  
   
         my @commentary_form = ();  
         my $ctarget = "window$$";  
         my $user = $cgi->param('user');  
         push(@commentary_form,$cgi->start_form(-target => $ctarget,  
                                                -action => &FIG::cgi_url . "/chromosomal_clusters.cgi"  
                                                ));  
         push(@commentary_form,$cgi->hidden(-name => "request", -value => "show_commentary"));  
         push(@commentary_form,$cgi->hidden(-name => "prot", -value => $peg));  
         push(@commentary_form,$cgi->hidden(-name => "user", -value => $user));  
   
         my($gene,$n,%how_many,$val,@vals,$x);  
         my($i,$map);  
         @vals = ();  
         for ($i=(@$gg - 1); ($i >= 0); $i--)  
         {  
             my @vals1 = ();  
             $map = $gg->[$i];  
             my $found = 0;  
             my $got_red = 0;  
             undef %how_many;  
             foreach $gene (@{$map->[3]})  
             {  
                 if (($x = $gene->[3]) ne "grey")  
                 {  
                     $n = $gene->[4];  
                     if ($n == 1) { $got_red = 1 }  
                     $how_many{$n}++;  
                     $gene->[5] =~ /(fig\|\d+\.\d+\.peg\.\d+)/;  
                     $val = join("@",($n,$i,$1,$map->[0],$how_many{$n}));  
                     push(@vals1,$val);  
                     $found++;  
                 }  
             }  
   
             if (! $got_red)  
             {  
                 splice(@$gg,$i,1);  
             }  
             else  
             {  
                 push(@vals,@vals1);  
             }  
         }  
   
         if (@$gg == 0)  
         {  
             push(@$html,$cgi->h1("Sorry, no pins worked out"));  
         }  
         else  
         {  
             push(@commentary_form,$cgi->hidden(-name => "show", -value => [@vals]));  
             push(@commentary_form,$cgi->submit('commentary'));  
             push(@commentary_form,$cgi->end_form());  
             push(@$html,@commentary_form);  
         }  
         ################################################################end commentary  
         push(@$html,@{ &GenoGraphics::render($gg,700,4,0,2) });  
     }  
 }  
   
 sub closest_pegs {  
     my($fig,$peg,$n) = @_;  
     my($id2,$d,$peg2,$i);  
   
     my @closest = map { $id2 = $_->id2; ($id2 =~ /^fig\|/) ? $id2 : () } $fig->sims($peg,5,1.0e-20,"all");  
   
     if (@closest > $n) { $#closest = $n-1 }  
     my %closest = map { $_ => 1 } @closest;  
     my @pinned_to = grep { $_ ne $peg} $fig->in_pch_pin_with($peg);  
     my $g1 = &FIG::genome_of($peg);  
     @pinned_to =  
         map {$_->[1] }  
         sort { $a->[0] <=> $b->[0] }  
         map { $peg2 = $_; $d = $fig->crude_estimate_of_distance($g1,&FIG::genome_of($peg2)); [$d,$peg2] }  
         @pinned_to;  
429    
     for ($i=0; ($i < @pinned_to) && ($i < $n); $i++)  
     {  
         $closest{$pinned_to[$i]} = 1;  
     }  
     return return keys(%closest);  
 }  
430    
 sub build_maps {  
     my($fig,$pinned_pegs,$all_pegs) = @_;  
     my($gg,$loc,$contig,$beg,$end,$mid,$min,$max,$genes,$feat,$fid);  
     my($contig1,$beg1,$end1,$map,$peg);  
   
     $gg = [];  
     foreach $peg (@$pinned_pegs)  
     {  
         $loc = $fig->feature_location($peg);  
         ($contig,$beg,$end) = &FIG::boundaries_of($loc);  
         if ($contig && $beg && $end)  
         {  
             $mid = int(($beg + $end) / 2);  
             $min = $mid - 8000;  
             $max = $mid + 8000;  
             $genes = [];  
             ($feat,undef,undef) = $fig->genes_in_region(&FIG::genome_of($peg),$contig,$min,$max);  
             foreach $fid (@$feat)  
             {  
                 ($contig1,$beg1,$end1) = &FIG::boundaries_of(scalar $fig->feature_location($fid));  
                 $beg1 = &in_bounds($min,$max,$beg1);  
                 $end1 = &in_bounds($min,$max,$end1);  
                 push(@$genes,[&FIG::min($beg1,$end1),  
                               &FIG::max($beg1,$end1),  
                               ($beg1 < $end1) ? "rightArrow" : "leftArrow",  
                               "grey",  
                               "",  
                               $fid]);  
   
                 if ($fid =~ /peg/)  
                 {  
                     push(@$all_pegs,$fid);  
                 }  
             }  
             $map = [&FIG::abbrev($fig->org_of($peg)),0,$max+1-$min,  
                     ($beg < $end) ? &decr_coords($genes,$min) : &flip_map($genes,$min,$max)];  
             push(@$gg,$map);  
         }  
     }  
   
     my(%seen,$abbr);  
     foreach $map (@$gg)  
     {  
         $abbr = $map->[0];  
         if (defined($seen{$abbr}))  
         {  
             $seen{$abbr}++;  
             $map->[0] = substr($map->[0],0,10) . "\*$seen{$abbr}";  
         }  
         else  
         {  
             $seen{$abbr} = 0;  
         }  
     }  
     return $gg;  
 }  
431    
432  sub in {  sub in {
433      my($x,$xL) = @_;      my($x,$xL) = @_;
# Line 1590  Line 594 
594      return $url;      return $url;
595  }  }
596    
597  sub possible_extensions {  sub trans_function_of {
598      my($peg,$closest_pegs) = @_;      my($cgi,$fig,$peg,$user) = @_;
     my($g,$sim,$id2,$peg1,%poss);  
   
     $g = &FIG::genome_of($peg);  
599    
600      foreach $peg1 (@$closest_pegs)      if (wantarray())
     {  
         if ($g ne &FIG::genome_of($peg1))  
         {  
             foreach $sim ($fig->sims($peg1,500,1.0e-5,"all"))  
601              {              {
602                  $id2 = $sim->id2;          my $x;
603                  if (($id2 ne $peg) && ($id2 =~ /^fig\|$g\./) && $fig->possibly_truncated($id2))          my @funcs = $fig->function_of($peg);
604            if ($cgi->param('translate'))
605                  {                  {
606                      $poss{$id2} = 1;              @funcs = map { $x = $_; $x->[1] = $fig->translate_function($x->[1]); $x } @funcs;
607                  }                  }
608            return @funcs;
609              }              }
610        else
611        {
612            my $func = $fig->function_of($peg,$user);
613            if ($cgi->param('translate'))
614            {
615                $func = $fig->translate_function($func);
616          }          }
617            return $func;
618      }      }
     return keys(%poss);  
619  }  }
620    

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3