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

Diff of /FigWebServices/subsys.cgi

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

revision 1.185, Sun Dec 31 23:30:44 2006 UTC revision 1.186, Sun Dec 31 23:51:58 2006 UTC
# Line 16  Line 16 
16  # http://www.theseed.org/LICENSE.TXT.  # http://www.theseed.org/LICENSE.TXT.
17  #  #
18    
   
19  use FIG;  use FIG;
20  use FIGjs;  # mouseover()  use FIGjs;  # mouseover()
21  use GD;  use GD;
# Line 80  Line 79 
79      exit;      exit;
80  }  }
81    
82    # Some timing code that can be deleted:  ## time ##
83    my $time_it = 0;                         ## time ##
84    my @times;                               ## time ##
85    push @times, scalar time() if $time_it;  ## time ##
86    
87  my $html = [];  my $html = [];
88  push @$html, "<TITLE>SEED Subsystems</TITLE>\n"; # RAE: every page deserves a title  push @$html, ( $cgi->param('ssa_name') ? "<TITLE>SEED Subsystem: " . $cgi->param('ssa_name') . "</TITLE>\n"
89                                           : "<TITLE>SEED Subsystems</TITLE>\n"
90                 ); # RAE: every page deserves a title
91    
92  my $user = $cgi->param('user');  my $user = $cgi->param('user');
93  if ($user !~ /^master:/) { $user = "master:$user" }  if ($user !~ /^master:/) { $user = "master:$user" }
# Line 1432  Line 1438 
1438          }          }
1439      }      }
1440    
1441        if ( $time_it )                  ## time ##
1442        {                                ## time ##
1443            push @times, scalar time();  ## time ##
1444            push @$html, "<br>dT = @{[$times[-1]-$times[-2]]}, T = @{[$times[-1]-$times[0]]}<br>";  ## time ##
1445        }                                ## time ##
1446    
1447      push(@$html, $cgi->start_form(-action => "subsys.cgi",      push(@$html, $cgi->start_form(-action => "subsys.cgi",
1448                                    -method => 'post',                                    -method => 'post',
1449                                    -enctype => &CGI::MULTIPART),                                    -enctype => &CGI::MULTIPART),
# Line 1512  Line 1524 
1524      push(@$html,$cgi->checkbox(-name => 'ignore_alt', -value => 1, -override => 1, -label => 'ignore alternatives', -checked => ($cgi->param('ignore_alt'))),$cgi->br);      push(@$html,$cgi->checkbox(-name => 'ignore_alt', -value => 1, -override => 1, -label => 'ignore alternatives', -checked => ($cgi->param('ignore_alt'))),$cgi->br);
1525      push(@$html,$cgi->checkbox(-name => 'ext_ids', -value => 1, -checked => 0, -label => 'use external ids'),$cgi->br);      push(@$html,$cgi->checkbox(-name => 'ext_ids', -value => 1, -checked => 0, -label => 'use external ids'),$cgi->br);
1526      push(@$html,$cgi->checkbox(-name => 'show_clusters', -value => 1, -label => 'show clusters'),$cgi->br);      push(@$html,$cgi->checkbox(-name => 'show_clusters', -value => 1, -label => 'show clusters'),$cgi->br);
1527      #my @options=(); # uncomment this to ignore attributes  
1528      my @options=sort {uc($a) cmp uc($b)} $fig->get_genome_keys(); # get all hte genome keys      my @options = ();
1529        @options = sort {uc($a) cmp uc($b)} $fig->get_genome_keys(); # get all the genome keys
1530      unshift(@options, undef); # a blank field at the start      unshift(@options, undef); # a blank field at the start
1531      push(@$html,"color rows by each organism's attribute: &nbsp; ", $cgi->popup_menu(-name => 'color_by_ga', -values=>\@options), $cgi->br);      push(@$html,"color rows by each organism's attribute: &nbsp; ", $cgi->popup_menu(-name => 'color_by_ga', -values=>\@options), $cgi->br);
1532    
1533      @options=sort {uc($a) cmp uc($b)} $fig->get_peg_keys(); # get all the peg keys      #  Compile and order the attribute keys found on pegs:
1534    
1535      #putting essentiality attributes on top of popup menu      my $high_priority = qr/(essential|fitness)/i;
1536      my (@top_of_list,@bottom_of_list);      @options = sort { $b =~ /$high_priority/o <=> $a =~ /$high_priority/o
1537      unshift(@top_of_list, undef);                     || uc($a) cmp uc($b)
     foreach my $opt (@options){  
         if($opt =~/(.ssential|fitness)/){push(@top_of_list,$opt);}  
         else{push(@bottom_of_list,$opt)}  
1538      }      }
1539                   $fig->get_peg_keys();
1540        unshift @options, undef;  # Start list with empty
1541    
1542      push(@top_of_list,@bottom_of_list);      push( @$html, "color columns by each PEGs attribute: &nbsp; ",
1543                      $cgi->popup_menu(-name => 'color_by_peg_tag', -values=>\@options),
1544                      $cgi->br
1545            );
1546    
1547      push(@$html,"color columns by each PEGs attribute: &nbsp; ", $cgi->popup_menu(-name => 'color_by_peg_tag', -values=>\@top_of_list), $cgi->br);      if ( $time_it )                  ## time ##
1548        {                                ## time ##
1549            push @times, scalar time();  ## time ##
1550            push @$html, "<br>dT = @{[$times[-1]-$times[-2]]}, T = @{[$times[-1]-$times[0]]}<br>";  ## time ##
1551        }                                ## time ##
1552    
1553      push @$html, $cgi->checkbox(-name => 'show_missing', -value => 1, -checked => 0, -override => 1,-label => 'show missing'),      push @$html, $cgi->checkbox(-name => 'show_missing', -value => 1, -checked => 0, -override => 1,-label => 'show missing'),
1554                   $cgi->br, $cgi->br;                   $cgi->br, $cgi->br;
# Line 1583  Line 1602 
1602                    $cgi->br;                    $cgi->br;
1603    
1604    
1605        if ( $time_it )                  ## time ##
1606        {                                ## time ##
1607            push @times, scalar time();  ## time ##
1608            push @$html, "<br>dT = @{[$times[-1]-$times[-2]]}, T = @{[$times[-1]-$times[0]]}<br>";  ## time ##
1609        }                                ## time ##
1610    
1611      if ($can_alter)      if ($can_alter)
1612      {      {
1613          push(@$html,$cgi->checkbox(-name => 'refill', -value => 1, -checked => 0, -override => 1,-label => 'refill spreadsheet from scratch'),$cgi->br);          push(@$html,$cgi->checkbox(-name => 'refill', -value => 1, -checked => 0, -override => 1,-label => 'refill spreadsheet from scratch'),$cgi->br);
# Line 1633  Line 1658 
1658                                -name  => "realign_column"),                                -name  => "realign_column"),
1659                   $cgi->hr;                   $cgi->hr;
1660    
1661        if ( $time_it )                  ## time ##
1662        {                                ## time ##
1663            push @times, scalar time();  ## time ##
1664            push @$html, "<br>dT = @{[$times[-1]-$times[-2]]}, T = @{[$times[-1]-$times[0]]}<br>";  ## time ##
1665        }                                ## time ##
1666    
1667       # RAE: A new function to reannotate a single column       # RAE: A new function to reannotate a single column
1668       # I don't understand how you get CGI.pm to reset (and never have).       # I don't understand how you get CGI.pm to reset (and never have).
1669       # $cgi->delete("col_to_annotate"); # this does nothing to my script and there is always the last number in this box       # $cgi->delete("col_to_annotate"); # this does nothing to my script and there is always the last number in this box
# Line 1654  Line 1685 
1685               $cgi->br);               $cgi->br);
1686      }      }
1687    
1688        if ( $time_it )                  ## time ##
1689        {                                ## time ##
1690            push @times, scalar time();  ## time ##
1691            push @$html, "<br>dT = @{[$times[-1]-$times[-2]]}, T = @{[$times[-1]-$times[0]]}<br>";  ## time ##
1692        }                                ## time ##
1693    
1694      my $notes = $subsystem->get_notes();      my $notes = $subsystem->get_notes();
1695      if ($can_alter)      if ($can_alter)
1696      {      {
# Line 1665  Line 1702 
1702          push(@$html,$cgi->h2('notes'),"<pre>$notes</pre>");          push(@$html,$cgi->h2('notes'),"<pre>$notes</pre>");
1703      }      }
1704    
1705        if ( $time_it )                  ## time ##
1706        {                                ## time ##
1707            push @times, scalar time();  ## time ##
1708            push @$html, "<br>dT = @{[$times[-1]-$times[-2]]}, T = @{[$times[-1]-$times[0]]}<br>";  ## time ##
1709        }                                ## time ##
1710    
1711      # RAE Modified to add a line with the classification      # RAE Modified to add a line with the classification
1712      my $class=$subsystem->get_classification();      my $class=$subsystem->get_classification();
1713      if ($can_alter)      if ($can_alter)
# Line 1685  Line 1728 
1728         push (@$html, $cgi->h2('Classification'), "<table><tr><td>$$class[0]</td><td>$$class[1]</td></tr></table>\n");         push (@$html, $cgi->h2('Classification'), "<table><tr><td>$$class[0]</td><td>$$class[1]</td></tr></table>\n");
1729      }      }
1730    
1731        if ( $time_it )                  ## time ##
1732        {                                ## time ##
1733            push @times, scalar time();  ## time ##
1734            push @$html, "<br>dT = @{[$times[-1]-$times[-2]]}, T = @{[$times[-1]-$times[0]]}<br>";  ## time ##
1735        }                                ## time ##
1736    
1737      my @orgs = map { "$_->[0]: " . $_->[1] }      my @orgs = map { "$_->[0]: " . $_->[1] }
1738                 sort { $a->[1] cmp $b->[1] }                 sort { $a->[1] cmp $b->[1] }
1739                 map { [$_,$fig->genus_species($_)] }                 map { [$_,$fig->genus_species($_)] }
# Line 1795  Line 1844 
1844              &make_link_to_painted_diagram($fig,$cgi,$html);              &make_link_to_painted_diagram($fig,$cgi,$html);
1845          }          }
1846      }      }
1847    
1848        if ( $time_it )                  ## time ##
1849        {                                ## time ##
1850            push @times, scalar time();  ## time ##
1851            push @$html, "<br>dT = @{[$times[-1]-$times[-2]]}, T = @{[$times[-1]-$times[0]]}<br>";  ## time ##
1852        }                                ## time ##
1853  }  }
1854    
1855    
# Line 1805  Line 1860 
1860  sub format_extend_with {  sub format_extend_with {
1861      my( $fig, $cgi, $html, $subsystem ) = @_;      my( $fig, $cgi, $html, $subsystem ) = @_;
1862    
     # my $t1 = times();  
1863      my %genomes = map { $_ => 1 } $subsystem->get_genomes();      my %genomes = map { $_ => 1 } $subsystem->get_genomes();
1864    
1865      #      #
# Line 1872  Line 1926 
1926      my @orgs = ();      my @orgs = ();
1927      foreach my $domain ( @picker_domains )      foreach my $domain ( @picker_domains )
1928      {      {
1929          push @orgs, map { [ $_ , &genus_species_and_domain( $fig, $_ ) ] }          push @orgs, map { [ $_, $fig->genus_species_domain( $_ ) ] }
1930                      grep { ! $genomes{ $_ } }                      grep { ! $genomes{ $_ } }
1931                      $fig->genomes( $complete && $honor_complete{ $domain }, undef, $domain )                      $fig->genomes( $complete && $honor_complete{ $domain }, undef, $domain )
1932      }      }
# Line 1959  Line 2013 
2013                                        )                                        )
2014          );          );
2015    
2016      # my $t2 = times();      if ( $time_it )                  ## time ##
2017      # push @$html, "<br>Picker time = @{[$t2 - $t1]} for @{[scalar @orgs]} genomes<br>\n";      {                                ## time ##
2018            push @times, scalar time();  ## time ##
2019            push @$html, "<br>dT = @{[$times[-1]-$times[-2]]}, T = @{[$times[-1]-$times[0]]}<br>";  ## time ##
2020        }                                ## time ##
2021    
2022      push @$html, $cgi->hr;      push @$html, $cgi->hr;
2023  }  }
# Line 2053  Line 2110 
2110      push(@$html,&HTML::make_table($col_hdrs,$tab,"Functional Roles", %options),      push(@$html,&HTML::make_table($col_hdrs,$tab,"Functional Roles", %options),
2111                  $cgi->hr                  $cgi->hr
2112           );           );
2113    
2114        if ( $time_it )                  ## time ##
2115        {                                ## time ##
2116            push @times, scalar time();  ## time ##
2117            push @$html, "<br>dT = @{[$times[-1]-$times[-2]]}, T = @{[$times[-1]-$times[0]]}<br>";  ## time ##
2118        }                                ## time ##
2119  }  }
2120    
2121  sub format_existing_roles {  sub format_existing_roles {
# Line 2206  Line 2269 
2269      {      {
2270          push(@$html,$cgi->hidden(-name => 'active_subsetC', -value => 'All', -override => 1));          push(@$html,$cgi->hidden(-name => 'active_subsetC', -value => 'All', -override => 1));
2271      }      }
2272    
2273        if ( $time_it )                  ## time ##
2274        {                                ## time ##
2275            push @times, scalar time();  ## time ##
2276            push @$html, "<br>dT = @{[$times[-1]-$times[-2]]}, T = @{[$times[-1]-$times[0]]}<br>";  ## time ##
2277        }                                ## time ##
2278  }  }
2279    
2280  sub format_subsetsR {  sub format_subsetsR {
# Line 2251  Line 2320 
2320          $cgi->radio_group(-name=>"active_key", -values=>[keys %options], -labels=>\%options, -linebreak=>'true', -default=>"", columns=>4),          $cgi->radio_group(-name=>"active_key", -values=>[keys %options], -labels=>\%options, -linebreak=>'true', -default=>"", columns=>4),
2321          "</td></tr>\n</table>",          "</td></tr>\n</table>",
2322           );           );
2323    
2324        if ( $time_it )                  ## time ##
2325        {                                ## time ##
2326            push @times, scalar time();  ## time ##
2327            push @$html, "<br>dT = @{[$times[-1]-$times[-2]]}, T = @{[$times[-1]-$times[0]]}<br>";  ## time ##
2328        }                                ## time ##
2329  }  }
2330    
2331  sub format_existing_subsetsC {  sub format_existing_subsetsC {
# Line 2362  Line 2437 
2437          push(@$html, $cgi->hr, $cgi->h2("Subsystem Diagrams"));          push(@$html, $cgi->hr, $cgi->h2("Subsystem Diagrams"));
2438      }      }
2439    
2440        if ( $time_it )                  ## time ##
2441        {                                ## time ##
2442            push @times, scalar time();  ## time ##
2443            push @$html, "<br>dT = @{[$times[-1]-$times[-2]]}, T = @{[$times[-1]-$times[0]]}<br>";  ## time ##
2444        }                                ## time ##
2445    
2446      if (@diagrams)      if (@diagrams)
2447      {      {
2448          my @hdr = ("Diagram Name");          my @hdr = ("Diagram Name");
# Line 2443  Line 2524 
2524          push(@$html, $cgi->submit(-name => 'ma_data_diagram_action',          push(@$html, $cgi->submit(-name => 'ma_data_diagram_action',
2525                                    -label => 'View microarray data on diagram'));                                    -label => 'View microarray data on diagram'));
2526    
2527          my @options=sort {uc($a) cmp uc($b)} $fig->get_peg_keys(); # get all the peg keys          my @select_keys = ( undef, sort { uc($a) cmp uc($b) }
2528          unshift(@options, undef);                                     grep { /(Essential|fitness)/i }
2529          my @select_keys;                                     $fig->get_peg_keys()
2530          unshift(@select_keys, undef);                            );
         foreach my $o (@options){  
            if($o =~/(.ssential|fitness)/){push(@select_keys,$o)}  
         }  
2531    
2532          push(@tbl_attribute, ["Genome ID:", $cgi->textfield(-name => "att_data_genome_id",          push(@tbl_attribute, ["Genome ID:", $cgi->textfield(-name => "att_data_genome_id",
2533                                                       -value => "",                                                       -value => "",
# Line 2468  Line 2546 
2546          push(@$html, $cgi->submit(-name => 'paint_diagram_role_by_attribute_value',          push(@$html, $cgi->submit(-name => 'paint_diagram_role_by_attribute_value',
2547                                    -label => 'Color Matching Roles'));                                    -label => 'Color Matching Roles'));
2548    
2549        if ( $time_it )                  ## time ##
2550        {                                ## time ##
2551            push @times, scalar time();  ## time ##
2552            push @$html, "<br>dT = @{[$times[-1]-$times[-2]]}, T = @{[$times[-1]-$times[0]]}<br>";  ## time ##
2553        }                                ## time ##
2554    
2555      return @diagrams > 0;      return @diagrams > 0;
2556  }  }
2557    
# Line 2905  Line 2989 
2989            );            );
2990        }        }
2991    
2992        if ( $time_it )                  ## time ##
2993        {                                ## time ##
2994            push @times, scalar time();  ## time ##
2995            push @$html, "<br>dT = @{[$times[-1]-$times[-2]]}, T = @{[$times[-1]-$times[0]]}<br>";  ## time ##
2996        }                                ## time ##
2997    
2998      # add an explanation for the colors if we want one.      # add an explanation for the colors if we want one.
2999      if ($cgi->param('color_by_ga'))      if ($cgi->param('color_by_ga'))
3000      {      {
# Line 3836  Line 3926 
3926  sub ext_genus_species {  sub ext_genus_species {
3927      my( $fig, $genome ) = @_;      my( $fig, $genome ) = @_;
3928    
3929      my $gs = $fig->genus_species( $genome );      my ( $gs, $c ) = $fig->genus_species_domain( $genome );
     my $c  = $fig->genome_domain( $genome );  
3930      $c = ( $c =~ m/^Environ/i ) ? 'M' : substr($c, 0, 1);  # M for metagenomic      $c = ( $c =~ m/^Environ/i ) ? 'M' : substr($c, 0, 1);  # M for metagenomic
3931      return "$gs [$c]";      return "$gs [$c]";
3932  }  }
3933    
3934    
 sub genus_species_and_domain  
 {  
     my ( $fig, $genome ) = @_;  
     ( $fig->genus_species( $genome ), $fig->genome_domain( $genome ) );  
 }  
   
   
3935  sub show_tree {  sub show_tree {
3936    
3937      my($id,$gs);      my($id,$gs);

Legend:
Removed from v.1.185  
changed lines
  Added in v.1.186

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3