[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.50, Fri Feb 25 22:55:20 2005 UTC revision 1.51, Sat Feb 26 11:01:13 2005 UTC
# Line 283  Line 283 
283      my($set,$when,$comment);      my($set,$when,$comment);
284    
285      my $user = $cgi->param('user');      my $user = $cgi->param('user');
286      my @ssa = &existing_subsystem_annotations;      my @ssa = &existing_subsystem_annotations($fig);
287    
288      if (@ssa > 0)      if (@ssa > 0)
289      {      {
# Line 676  Line 676 
676      my $name  = $ssa;      my $name  = $ssa;
677      $name =~ s/_/ /g;      $name =~ s/_/ /g;
678      $ssa =~ s/[ \/]/_/g;      $ssa =~ s/[ \/]/_/g;
679      my $curator = &curator($ssa);      my $curator = $fig->subsystem_curator($ssa);
680      push(@$html, $cgi->h1("Subsystem: $name"),      push(@$html, $cgi->h1("Subsystem: $name"),
681                   $cgi->h1("Author: $curator"),                   $cgi->h1("Author: $curator"),
682                   $cgi->start_form(-action => "subsys.cgi",                   $cgi->start_form(-action => "subsys.cgi",
# Line 693  Line 693 
693      # errors to the end user (.e.g try setting can_alter and choosing an illegitimate ss      # errors to the end user (.e.g try setting can_alter and choosing an illegitimate ss
694      # Do we know about this subsystem:      # Do we know about this subsystem:
695      my $ssaQ = quotemeta $ssa;      my $ssaQ = quotemeta $ssa;
696      unless (grep {/$ssaQ/} map {$_->[0]} &existing_subsystem_annotations)      unless (grep {/$ssaQ/} map {$_->[0]} &existing_subsystem_annotations($fig))
697      {      {
698       # No, we don't know about this subsystem       # No, we don't know about this subsystem
699       my $url = &FIG::cgi_url . "/subsys.cgi?user=$user";       my $url = &FIG::cgi_url . "/subsys.cgi?user=$user";
# Line 1696  Line 1696 
1696    
1697          # RAE color the background if the subsystem is empty          # RAE color the background if the subsystem is empty
1698          # this uses a modification to HTML.pm that I made earlier to accept refs to arrays as cell data          # this uses a modification to HTML.pm that I made earlier to accept refs to arrays as cell data
1699          my $cell1=&ssa_link($ssa,$user);          my $cell1=&ssa_link($fig,$ssa,$user);
1700          #unless (scalar $fig->subsystem_to_roles($ssa)) {$cell1 = [$cell1, 'td bgcolor="Dark grey"']} ## THIS IS DOG SLOW, BUT WORKS          #unless (scalar $fig->subsystem_to_roles($ssa)) {$cell1 = [$cell1, 'td bgcolor="Dark grey"']} ## THIS IS DOG SLOW, BUT WORKS
1701          #unless (scalar $fig->get_subsystem($ssa)->get_genomes()) {$cell1 = [$cell1, 'td bgcolor="#A9A9A9"']} ## WORKS PERFECTLY, but sort of slow          #unless (scalar $fig->get_subsystem($ssa)->get_genomes()) {$cell1 = [$cell1, 'td bgcolor="#A9A9A9"']} ## WORKS PERFECTLY, but sort of slow
1702          unless (scalar @{$fig->subsystem_genomes($ssa, 1)}) {$cell1 = [$cell1, 'td bgcolor="silver"']}          unless (scalar @{$fig->subsystem_genomes($ssa, 1)}) {$cell1 = [$cell1, 'td bgcolor="silver"']}
# Line 1727  Line 1727 
1727  # Subsystems.pm and called subsystems I know about or something.  # Subsystems.pm and called subsystems I know about or something.
1728  # Cowardly didn't do though :-)  # Cowardly didn't do though :-)
1729  sub existing_subsystem_annotations {  sub existing_subsystem_annotations {
1730        my($fig) = @_;
1731      my($ssa,$name);      my($ssa,$name);
1732      my @ssa = ();      my @ssa = ();
1733      if (opendir(SSA,"$FIG_Config::data/Subsystems"))      if (opendir(SSA,"$FIG_Config::data/Subsystems"))
1734      {      {
1735          @ssa = map { $ssa = $_; $name = $ssa; $ssa =~ s/[ \/]/_/g; [$name,&curator($ssa)] } grep { $_ !~ /^\./ } readdir(SSA);          @ssa = map { $ssa = $_; $name = $ssa; $ssa =~ s/[ \/]/_/g; [$name,$fig->subsystem_curator($ssa)] } grep { $_ !~ /^\./ } readdir(SSA);
1736          closedir(SSA);          closedir(SSA);
1737      }      }
1738      return sort { (lc $a->[0]) cmp (lc $b->[0]) } @ssa;      return sort { (lc $a->[0]) cmp (lc $b->[0]) } @ssa;
1739  }  }
1740    
1741  sub ssa_link {  sub ssa_link {
1742      my($ssa,$user) = @_;      my($fig,$ssa,$user) = @_;
1743      my $name = $ssa; $name =~ s/_/ /g;      my $name = $ssa; $name =~ s/_/ /g;
1744      my $target = "window$$";      my $target = "window$$";
1745      if ($name =~ /([a-zA-Z]{3})/)      if ($name =~ /([a-zA-Z]{3})/)
# Line 1746  Line 1747 
1747          $target .= ".$1";          $target .= ".$1";
1748      }      }
1749    
1750      my $can_alter = &curator($ssa) eq $user;      my $can_alter = $fig->subsystem_curator($ssa) eq $user;
1751    
1752      my $url = &FIG::cgi_url . "/subsys.cgi?user=$user&ssa_name=$ssa&request=show_ssa&can_alter=$can_alter";      my $url = &FIG::cgi_url . "/subsys.cgi?user=$user&ssa_name=$ssa&request=show_ssa&can_alter=$can_alter";
1753      return "<a href=$url target=$target>$name</a>";      return "<a href=$url target=$target>$name</a>";
1754  }  }
1755    
 sub curator {  
     my($ssa) = @_;  
     my($who) = "";  
   
     if (open(DATA,"<$FIG_Config::data/Subsystems/$ssa/curation.log"))  
     {  
         $_  = <DATA>;  
         if ($_ =~ /^\d+\t(\S+)\s+started/)  
         {  
             $who = $1;  
         }  
         close(DATA);  
     }  
     return $who;  
 }  
   
1756  sub log_update {  sub log_update {
1757      my($ssa,$user) = @_;      my($ssa,$user) = @_;
1758    
# Line 1804  Line 1789 
1789      {      {
1790          $user =~ s/^master://;          $user =~ s/^master://;
1791          &FIG::verify_dir("$FIG_Config::data/Assignments/$user");          &FIG::verify_dir("$FIG_Config::data/Assignments/$user");
1792          my $who = &curator($ssa);          my $who = $fig->subsystem_curator($ssa);
1793          my $file = &FIG::epoch_to_readable(time) . ":$who:generated_from_subsystem_$ssa";          my $file = &FIG::epoch_to_readable(time) . ":$who:generated_from_subsystem_$ssa";
1794    
1795          if (open(OUT,">$FIG_Config::data/Assignments/$user/$file"))          if (open(OUT,">$FIG_Config::data/Assignments/$user/$file"))

Legend:
Removed from v.1.50  
changed lines
  Added in v.1.51

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3