[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.3, Wed Oct 6 20:37:38 2004 UTC revision 1.9, Mon Mar 12 13:39:05 2007 UTC
# Line 1  Line 1 
1    #
2    # Copyright (c) 2003-2006 University of Chicago and Fellowship
3    # for Interpretations of Genomes. All Rights Reserved.
4    #
5    # This file is part of the SEED Toolkit.
6    #
7    # The SEED Toolkit is free software. You can redistribute
8    # it and/or modify it under the terms of the SEED Toolkit
9    # Public License.
10    #
11    # You should have received a copy of the SEED Toolkit Public License
12    # along with this program; if not write to the University of Chicago
13    # at info@ci.uchicago.edu or the Fellowship for Interpretation of
14    # Genomes at veronika@thefig.info or download a copy from
15    # http://www.theseed.org/LICENSE.TXT.
16    #
17    
18  use FIG;  use FIG;
19  my $fig = new FIG;  my $fig = new FIG;
20    
# Line 6  Line 23 
23  use GenoGraphics;  use GenoGraphics;
24  use CGI;  use CGI;
25  my $cgi = new CGI;  my $cgi = new CGI;
26    use FIG_CGI;
27    use FigWebServices::SeedComponents;
28    
29  if (0)  my ($fig, $cgi, $user) = FIG_CGI::init(debug_save   => 0,
30  {                                         debug_load   => 0,
31      my $VAR1;                                         print_params => 0
32      eval(join("",`cat /tmp/protein_parms`));                                        );
     $cgi = $VAR1;  
 #   print STDERR &Dumper($cgi);  
 }  
   
 if (0)  
 {  
     print $cgi->header;  
     my @params = $cgi->param;  
     print "<pre>\n";  
     foreach $_ (@params)  
     {  
         print "$_\t:",join(",",$cgi->param($_)),":\n";  
     }  
   
     if (0)  
     {  
         if (open(TMP,">/tmp/protein_parms"))  
         {  
             print TMP &Dumper($cgi);  
             close(TMP);  
         }  
     }  
     exit;  
 }  
   
33  my $html = [];  my $html = [];
34  unshift @$html, "<TITLE>The SEED Feature Page</TITLE>\n";  unshift @$html, "<TITLE>The SEED Feature Page</TITLE>\n";
35    push(@$html,"<link type='text/css' rel='stylesheet' href='./Html/frame.css'>");
36    
37  my $feature = $cgi->param('feature');  my $feature = $cgi->param('feature');
38  if (! $feature)  if (! $feature)
# Line 134  Line 129 
129    
130      unshift @$html, "<TITLE>The SEED: Feature Page</TITLE>\n";      unshift @$html, "<TITLE>The SEED: Feature Page</TITLE>\n";
131      my $gs = $fig->org_of($feature);      my $gs = $fig->org_of($feature);
132      if ($feature =~ /^fig\|\d+\.\d+\.peg/)  
     {  
133          if (! $fig->is_real_feature($feature))          if (! $fig->is_real_feature($feature))
134          {          {
135              push(@$html,"<h1>Sorry, $feature is an unknown identifier</h1>\n");              push(@$html,"<h1>Sorry, $feature is an unknown identifier</h1>\n");
# Line 143  Line 137 
137          else          else
138          {          {
139              push(@$html,"<h1>Feature $feature: $gs</h1>\n");              push(@$html,"<h1>Feature $feature: $gs</h1>\n");
140              my $msg;          my $url = $cgi->url(-relative => 1, -query => 1, -path_info => 1);
141              my $url = $cgi->self_url();          &display_fid($fig,$cgi,$html,$feature);
             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,$feature);  
         }  
     }  
     else  
     {  
         &display_external($fig,$cgi,$html,$feature);  
142      }      }
143  }  }
144    
145  #==============================================================================  #==============================================================================
146  #  display_peg  #  display_fid
147  #==============================================================================  #==============================================================================
148    
149  sub display_peg {  sub display_fid {
150      my($fig,$cgi,$html,$peg) = @_;      my($fig,$cgi,$html,$fid) = @_;
151      my $loc;      my $loc;
152    
     my $half_sz = 5000;  
   
     if ($loc = $fig->feature_location($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);  
153    
154          &print_context($fig,$cgi,$html,$peg,$feat,$min,$max);      my $graph = &FigWebServices::SeedComponents::Protein::get_peg_view({ fig_object => $fig,
155                                                                              peg_id     => $fid
156      }      }
157                                                                            );
158        push(@$html,$graph);
159    
160      #&print_assignments($fig,$cgi,$html,$peg);      my $contextH = &FigWebServices::SeedComponents::Protein::get_chromosome_context({ fig_object => $fig,
161      my @links = $fig->peg_links($peg);                                                                                         peg_id     => $fid
     if (@links > 0)  
     {  
         my $col_hdrs = [1,2,3,4,5];  
         my $title    = "Links to Related Entries in Other Sites";  
         my $tab = [];  
         my ($n,$i);  
         for ($i=0; ($i < @links); $i += 5)  
         {  
             $n = (($i + (5-1)) < @links) ? $i+(5-1) : $i+(@links - $i);  
             push(@$tab,[@links[$i..$n]]);  
         }  
         push(@$html,&HTML::make_table($col_hdrs,$tab,$title));  
162      }      }
163                                                                                         );
164    
165        push(@$html,$contextH->{table});
166    
167      push(@$html,$cgi->hr);      push(@$html,$cgi->hr);
168      my $link1 = $cgi->self_url() . "&request=view_annotations";      my $link1 = $cgi->url(-relative => 1, -query => 1, -path_info => 1) . "&request=view_annotations";
169      my $link2 = $cgi->self_url() . "&request=view_all_annotations";      my $link2 = $cgi->url(-relative => 1, -query => 1, -path_info => 1) . "&request=view_all_annotations";
170      push(@$html,"<br><a href=$link1>To View Annotations</a>/<a href=$link2>To View All Related Annotations</a>\n");      push(@$html,"<br><a href=$link1>To View Annotations</a>/<a href=$link2>To View All Related Annotations</a>\n");
171    
172    
173      my $link = $cgi->self_url() . "&request=dna_sequence";      my $link = $cgi->url(-relative => 1, -query => 1, -path_info => 1) . "&request=dna_sequence";
174      push(@$html,"<br><a href=$link>DNA Sequence</a>\n");      push(@$html,"<br><a href=$link>DNA Sequence</a>\n");
175    
176      $link = $cgi->url();      $link = $cgi->url(-relative => 1);
177      $link =~ s/protein.cgi/fid_checked.cgi/;      $link =~ s/protein.cgi/fid_checked.cgi/;
178      my $user = $cgi->param('user');      my $user = $cgi->param('user');
179      if (! $user)      if (! $user)
# Line 222  Line 186 
186          push(@$html,"<br><a href=$link target=checked_window>To Make an Annotation</a>\n");          push(@$html,"<br><a href=$link target=checked_window>To Make an Annotation</a>\n");
187      }      }
188    
189      my $has_translation = $fig->translatable($peg);      my $has_translation = $fig->translatable($fid);
   
   
 }  
   
   
   
   
 ################# Context on the Chromosome ############################  
   
 sub print_context {  
     my($fig,$cgi,$html,$peg,$feat,$beg,$end) = @_;  
     my($contig1,$beg1,$end1,$strand,$max_so_far,$comment, $aliases);  
     my($fid1,$sz,$color,$map,$gg,$n,$link);  
   
   
     my $user = $cgi->param('user');  
     push(@$html,$cgi->start_form(-action => &FIG::cgi_url . "/chromosomal_clusters.cgi"),  
                 $cgi->hidden(-name => "feature", -value => $peg),  
                 $cgi->hidden(-name => "user", -value => $user));  
   
     my $col_hdrs = ["fid","starts","ends","size","","comment","aliases"];  
     my($tab) = [];  
     my $genes = [];  
   
     #my $peg_function = &trans_function_of($cgi,$fig,$peg,$user);  
   
     #my($role,$role1,%related_roles);  
     #foreach $role (&FIG::roles_of_function($peg_function))  
     #{  
 #       foreach $role1 ($fig->neighborhood_of_role($role))  
 #       {  
 #           $related_roles{$role1} = 1;  
 #       }  
 #    }  
   
     foreach $fid1 (@$feat)  
     {  
         $aliases = join( ', ', $fig->feature_aliases($fid1) );  
         ($contig1,$beg1,$end1) = $fig->boundaries_of(scalar $fig->feature_location($fid1));;  
         $strand = ($beg1 < $end1) ? "+" : "-";  
   
         if     ($fid1 eq $peg)    { $color = "green" }  
         else                      { $color = "red" }  
   
         if ($fid1 =~ /peg\.(\d+)$/)  
         {  
             $n = $1;  
             $link = $cgi->url() . "?feature=$fid1&user=$user";  
         }  
         elsif ($fid1 =~ /\.([a-z]+)\.\d+$/)  
         {  
             $n = uc $1;  
             $link = "";  
         }  
         else  
         {  
             $n ="";  
             $link = "";  
         }  
   
         push(@$genes,[&FIG::min($beg1,$end1),&FIG::max($beg1,$end1),($strand eq "+") ? "rightArrow" : "leftArrow", $color,$n,$link]);  
         $max_so_far = &FIG::max($beg1,$end1);  
   
   
         if (&FIG::ftype($fid1) eq "peg")  
         {  
             $comment = &trans_function_of($cgi,$fig,$fid1,$user);  
         }  
         else  
         {  
             $comment = "";  
         }  
         $comment = &set_map_links($fig,&FIG::genome_of($fid1),$comment);  
         if ($fid1 eq $peg)  
         {  
             $comment = "\@bgcolor=\"#00FF00\":$comment";  
         }  
         $sz = abs($end1-$beg1)+1;  
   
   
         push(@$tab,[&HTML::fid_link($cgi,$fid1,"local"),$beg1,$end1,$sz,$strand,  
                     $comment,&HTML::set_prot_links($cgi,$aliases)]);  
     }  
     $map = ["",$beg,$end,$genes];  
     $gg = [$map];  
     push(@$html,&HTML::make_table($col_hdrs,$tab,"Context on contig $contig1"));  
 #    push(@$html,$cgi->br,$cgi->submit('pin with checked genes'),$cgi->end_form,$cgi->br);  
     push(@$html,@{ &GenoGraphics::render($gg,700,4,0,1) });  
     return;  
 }  
   
 sub set_map_links {  
     my($fig,$org,$func) = @_;  
   
     if ($func =~ /^(.*)(\d+\.\d+\.\d+\.\d+)(.*)$/)  
     {  
         my $before = $1;  
         my $ec     = $2;  
         my $after  = $3;  
         return &set_map_links($fig,$org,$before) . &set_ec_to_maps($fig,$org,$ec) . &set_map_links($fig,$org,$after);  
     }  
     return $func;  
 }  
   
 sub set_ec_to_maps {  
     my($fig,$org,$ec) = @_;  
   
     my @maps = $fig->ec_to_maps($ec);  
     if (@maps > 0)  
     {  
         $cgi->delete('request');  
         my $url  = $cgi->self_url() . "&request=ec_to_maps&ec=$ec&org=$org";  
         my $link = "<a href=\"$url\">$ec</a>";  
         return $link;  
     }  
     return $ec;  
 }  
   
 sub show_ec_to_maps {  
     my($fig,$cgi,$html,$ec) = @_;  
   
     my $ec = $cgi->param('ec');  
     if (! $ec)  
     {  
         push(@$html,$cgi->h1("Missing EC number"));  
         return;  
     }  
   
     my @maps = $fig->ec_to_maps($ec);  
     if (@maps > 0)  
     {  
         my $col_hdrs = ["map","metabolic topic"];  
         my $map;  
         my $tab      = [map { $map = $_; [&map_link($cgi,$map),$fig->map_name($map)] } @maps];  
         push(@$html,&HTML::make_table($col_hdrs,$tab,"$ec: " . $fig->ec_name($ec)));  
     }  
 }  
   
 sub map_link {  
     my($cgi,$map) = @_;  
190    
     $cgi->delete('request');  
     my $url  = $cgi->self_url() . "&request=link_to_map&map=$map";  
     my $link = "<a href=\"$url\">$map</a>";  
     return $link;  
 }  
191    
 sub link_to_map {  
     my($fig,$cgi,$html) = @_;  
   
     my $map = $cgi->param('map');  
     if (! $map)  
     {  
         push(@$html,$cgi->h1("Missing Map"));  
         return;  
192      }      }
193    
     my $org = $cgi->param('org');  
     if (! $org)  
     {  
         push(@$html,$cgi->h1("Missing Org Parameter"));  
         return;  
     }  
     my$user = $cgi->param('user');  
     $user = $user ? $user : "";  
   
     $ENV{"REQUEST_METHOD"} = "GET";  
     $ENV{"QUERY_STRING"} = "user=$user&map=$map&org=$org";  
     my @out = `./show_kegg_map.cgi`;  
     &HTML::trim_output(\@out);  
     push(@$html,@out);  
 }  
   
   
194  sub dna_sequence {  sub dna_sequence {
195      my($fig,$cgi,$html,$fid) = @_;      my($fig,$cgi,$html,$fid) = @_;
196      my($seq,$func,$i);      my($seq,$func,$i);
# Line 586  Line 380 
380    
381      my $prot = $cgi->param('prot');      my $prot = $cgi->param('prot');
382      $cgi->delete('prot');      $cgi->delete('prot');
383      my $url  = $cgi->self_url() . "&prot=$peg&compare_region=1";      my $url  = $cgi->url(-relative => 1, -query => 1, -path_info => 1) . "&prot=$peg&compare_region=1";
384      $cgi->delete('prot');      $cgi->delete('prot');
385      $cgi->param(-name => 'prot', -value => $prot);      $cgi->param(-name => 'prot', -value => $prot);
386    

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.9

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3