[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.8, Tue Sep 28 20:39:39 2004 UTC revision 1.9, Sun Oct 10 17:13:55 2004 UTC
# Line 2  Line 2 
2    
3  use FIG;  use FIG;
4  my $fig = new FIG;  my $fig = new FIG;
5    
6  use Subsystem;  use Subsystem;
7    
8  use HTML;  use HTML;
# Line 9  Line 10 
10  use tree_utilities;  use tree_utilities;
11    
12  use CGI;  use CGI;
13    
14  my $cgi = new CGI;  my $cgi = new CGI;
15    
16  if (0)  if (0)
# Line 59  Line 61 
61  {  {
62      push(@$html,$cgi->h1("Sorry, you need to specify a master user to modify subsystem annotations"));      push(@$html,$cgi->h1("Sorry, you need to specify a master user to modify subsystem annotations"));
63  }  }
64    elsif ($cgi->param('resynch_peg_connections') && (my $ssa = $cgi->param('ssa_name')))
65    {
66        my $subsystem = new Subsystem($ssa,$fig,0);
67        $subsystem->db_sync(0);
68        undef $subsystem;
69        &one_cycle($fig,$cgi,$html);
70    }
71  elsif ($cgi->param("extend_with_billogix"))  elsif ($cgi->param("extend_with_billogix"))
72  {  {
73      #      #
# Line 118  Line 127 
127      elsif    ($request eq "reset_to")      elsif    ($request eq "reset_to")
128      {      {
129          &reset_ssa_to($fig,$cgi,$html);     # this actually resets to the previous version          &reset_ssa_to($fig,$cgi,$html);     # this actually resets to the previous version
130          &show_ssa($fig,$cgi,$html);          &one_cycle($fig,$cgi,$html);
131      }      }
132      elsif    ($request eq "make_exchangable")      elsif    ($request eq "make_exchangable")
133      {      {
# Line 359  Line 368 
368    
369      if ($copy_from1 && (@cols_to_take1 > 0))      if ($copy_from1 && (@cols_to_take1 > 0))
370      {      {
371          $subsystem->add_to_subsys($copy_from1,\@cols_to_take1,"take notes");  # add columns and notes          $subsystem->add_to_subsystem($copy_from1,\@cols_to_take1,"take notes");  # add columns and notes
372      }      }
373    
374      if ($copy_from2 && (@cols_to_take2 > 0))      if ($copy_from2 && (@cols_to_take2 > 0))
375      {      {
376          $subsystem->add_to_subsys($copy_from2,\@cols_to_take2,"take notes");  # add columns and notes          $subsystem->add_to_subsystem($copy_from2,\@cols_to_take2,"take notes");  # add columns and notes
377      }      }
378    
379      $subsystem->write_subsystem();      $subsystem->write_subsystem();
# Line 378  Line 387 
387  #  #
388  #     1. Load the existing spreadsheet  #     1. Load the existing spreadsheet
389  #     2. reconcile row and subset changes  #     2. reconcile row and subset changes
390  #     3. process spreadsheet changes (fill/refill/add genomes)  #     3. process spreadsheet changes (fill/refill/add genomes/update variants)
391  #     4. write the updated spreadsheet back to disk  #     4. write the updated spreadsheet back to disk
392  #     5. render the spreadsheet  #     5. render the spreadsheet
393  #  #
# Line 388  Line 397 
397      my $user = $cgi->param('user');      my $user = $cgi->param('user');
398      my $ssa  = $cgi->param('ssa_name');      my $ssa  = $cgi->param('ssa_name');
399    
   
400      if  (! $user)      if  (! $user)
401      {      {
402          push(@$html,$cgi->h1('You need to specify a user to work on a subsystem annotation'));          push(@$html,$cgi->h1('You need to specify a user to work on a subsystem annotation'));
# Line 430  Line 438 
438              {              {
439                  if ($r = $cgi->param("role$n"))                  if ($r = $cgi->param("role$n"))
440                  {                  {
441                        $r =~ s/^\s+//;
442                        $r =~ s/\s+$//;
443    
444                      if (($p = $cgi->param("posR$n")) && ($abr = $cgi->param("abbrev$n")))                      if (($p = $cgi->param("posR$n")) && ($abr = $cgi->param("abbrev$n")))
445                      {                      {
446                          push(@tuplesR,[$p,$r,$abr]);                          push(@tuplesR,[$p,$r,$abr]);
# Line 444  Line 455 
455          }          }
456          $subsystem->set_roles([map { [$_->[1],$_->[2]] } sort { $a->[0] <=> $b->[0] } @tuplesR]);          $subsystem->set_roles([map { [$_->[1],$_->[2]] } sort { $a->[0] <=> $b->[0] } @tuplesR]);
457    
458          my($subset_name,$s,$test,@entries,$entry);  
459          my @subset_names  = grep { $_ =~ /^subset_name/ } $cgi->param();          my($subset_name,$s,$test,$entries,$entry);
460          foreach $subset_name (@subset_names)          my @subset_names  = grep { $_ =~ /^nameCS/ } $cgi->param();
461    
462            if (@subset_names == 0) { return 1 }
463    
464            my %defined_subsetsC;
465            foreach $s (@subset_names)
466          {          {
467              if (($subset_name =~ /^subset_name(\d+)/) && defined($n = $1) && ($s = $cgi->param("nameCS$n")))              if (($s =~ /^nameCS(\d+)/) && defined($n = $1) && ($subset_name = $cgi->param($s)))
468              {              {
469    
470                  my($text);                  my($text);
471                  if ($text = $cgi->param("subset$n"))                  $entries = [];
472                    if ($text = $cgi->param("subsetC$n"))
473                  {                  {
                     @entries = ();  
474                      foreach $entry (split(/[\s,]+/,$text))                      foreach $entry (split(/[\s,]+/,$text))
475                      {                      {
476                          if ($role = &to_role($entry,\@tuplesR))                          if ($role = &to_role($entry,\@tuplesR))
477                          {                          {
478                              push(@entries,$role);                              push(@$entries,$role);
479                          }                          }
480                          else                          else
481                          {                          {
# Line 466  Line 483 
483                              return 0;                              return 0;
484                          }                          }
485                      }                      }
                     $subsystem->set_subset($s,\@entries);  
486                  }                  }
487                    $defined_subsetsC{$subset_name} = $entries;
488              }              }
489          }          }
490    
491            foreach $s ($subsystem->get_subset_namesC)
492            {
493                next if ($s eq "All");
494                if ($entries = $defined_subsetsC{$s})
495                {
496                    $subsystem->set_subsetC($s,$entries);
497                    delete $defined_subsetsC{$s};
498                }
499                else
500                {
501                    $subsystem->delete_subsetC($s);
502                }
503            }
504    
505            foreach $s (keys(%defined_subsetsC))
506            {
507                $subsystem->set_subsetC($s,$defined_subsetsC{$s});
508            }
509      }      }
510      return 1;      return 1;
511  }  }
# Line 478  Line 514 
514      my($x,$role_tuples) = @_;      my($x,$role_tuples) = @_;
515      my $i;      my $i;
516    
517        if (($x =~ /^(\d+)$/) && ($1 <= @$role_tuples)) { return $role_tuples->[$x-1]->[1] }
518    
519      for ($i=0; ($i < @$role_tuples) &&      for ($i=0; ($i < @$role_tuples) &&
520                 ($role_tuples->[0] != $x) &&                 ($role_tuples->[0] != $x) &&
521                 ($role_tuples->[1] != $x) &&                 ($role_tuples->[1] != $x) &&
# Line 552  Line 590 
590          {          {
591              @pegs1 = sort $subsystem->get_pegs_from_cell($genome,$role);              @pegs1 = sort $subsystem->get_pegs_from_cell($genome,$role);
592              @pegs2 = sort $fig->seqs_with_role($role,"master",$genome);              @pegs2 = sort $fig->seqs_with_role($role,"master",$genome);
593    
594              if (@pegs1 != @pegs2)              if (@pegs1 != @pegs2)
595              {              {
596                  $subsystem->set_pegs_in_cell($genome,$role,\@pegs2);                  $subsystem->set_pegs_in_cell($genome,$role,\@pegs2);
# Line 686  Line 725 
725      {      {
726          push(@$html,          push(@$html,
727               $cgi->p,               $cgi->p,
728                 $cgi->hr,
729                 "You should resynch PEG connections only if you detect PEGs that should be connected to the
730                  spreadsheet, but do not seem to be.  This can only reflect an error in the code.  If you find
731                  yourself having to use it, send mail to Ross.",
732                 $cgi->br,
733                 $cgi->submit(-value => "Resynch PEG Connections",
734                              -name => "resynch_peg_connections"),
735                 $cgi->br,
736               $cgi->submit(-value => "Start automated subsystem extension",               $cgi->submit(-value => "Start automated subsystem extension",
737                               -name => "extend_with_billogix"),                               -name => "extend_with_billogix"),
738               $cgi->br);               $cgi->br);
# Line 878  Line 925 
925    
926      my $n = 1;      my $n = 1;
927      &format_existing_subsetsC($cgi,$html,$subsystem,$tab,\$n);      &format_existing_subsetsC($cgi,$html,$subsystem,$tab,\$n);
928    
929      if ($cgi->param('can_alter'))      if ($cgi->param('can_alter'))
930      {      {
931          my $i;          my $i;
# Line 887  Line 935 
935              $n++;              $n++;
936          }          }
937      }      }
938    
939      push(@$html,&HTML::make_table($col_hdrs,$tab,"Subsets of Roles"),      push(@$html,&HTML::make_table($col_hdrs,$tab,"Subsets of Roles"),
940                  $cgi->hr                  $cgi->hr
941           );           );
# Line 933  Line 982 
982    
983      foreach $nameCS (sort $subsystem->get_subset_namesC)      foreach $nameCS (sort $subsystem->get_subset_namesC)
984      {      {
985            if ($nameCS !~ /all/i)
986            {
987          &format_subsetC($cgi,$html,$subsystem,$tab,$$nP,$nameCS);          &format_subsetC($cgi,$html,$subsystem,$tab,$$nP,$nameCS);
988          $$nP++;          $$nP++;
989      }      }
990  }  }
991    }
992    
993  sub format_subsetC {  sub format_subsetC {
994      my($cgi,$html,$subsystem,$tab,$n,$nameCS) = @_;      my($cgi,$html,$subsystem,$tab,$n,$nameCS) = @_;
# Line 944  Line 996 
996      if ($nameCS ne "All")      if ($nameCS ne "All")
997      {      {
998          my $subset = $nameCS ? join(",",map { $subsystem->get_role_index($_) + 1 } $subsystem->get_subsetC_roles($nameCS)) : "";          my $subset = $nameCS ? join(",",map { $subsystem->get_role_index($_) + 1 } $subsystem->get_subsetC_roles($nameCS)) : "";
999    
1000            $nameCS = $subset ? $nameCS : "";
1001    
1002          my($posT,$subsetT);          my($posT,$subsetT);
1003    
1004          if ($cgi->param('can_alter'))          if ($cgi->param('can_alter'))
1005          {          {
1006              $posT    = $cgi->textfield(-name => "nameCS$n", -size => 30, -value => $nameCS, -override => 1);              $posT    = $cgi->textfield(-name => "nameCS$n", -size => 30, -value => $nameCS, -override => 1);
1007              $subsetT = $cgi->textfield(-name => "subsetC$n", -size => 80, -value => $subset, -override => 1);              $subsetT = $cgi->textfield(-name => "subsetC$n", -size => 80, -value => $subset, -override => 1);
1008                push(@$tab,[$posT,$subsetT]);
1009          }          }
1010          else          elsif ($subset)
1011          {          {
1012              push(@$html,$cgi->hidden(-name => "nameCS$n", -value => $nameCS, -override => 1),              push(@$html,$cgi->hidden(-name => "nameCS$n", -value => $nameCS, -override => 1),
1013                          $cgi->hidden(-name => "subsetC$n", -value => $subset, -override => 1));                          $cgi->hidden(-name => "subsetC$n", -value => $subset, -override => 1));
1014              $posT = $nameCS;              $posT = $nameCS;
1015              $subsetT = $subset;              $subsetT = $subset;
         }  
1016          push(@$tab,[$posT,$subsetT]);          push(@$tab,[$posT,$subsetT]);
1017      }      }
1018  }  }
1019    }
1020    
1021  sub tree_link {  sub tree_link {
1022      my $target = "window$$";      my $target = "window$$";
# Line 1331  Line 1388 
1388      my($ssa,$user) = @_;      my($ssa,$user) = @_;
1389      my $name = $ssa; $name =~ s/_/ /g;      my $name = $ssa; $name =~ s/_/ /g;
1390      my $target = "window$$";      my $target = "window$$";
1391        if ($name =~ /([a-zA-Z]{3})/)
1392        {
1393            $target .= ".$1";
1394        }
1395    
1396      my $can_alter = &curator($ssa) eq $user;      my $can_alter = &curator($ssa) eq $user;
1397    
1398      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";
# Line 1999  Line 2061 
2061      return @with_links;      return @with_links;
2062  }  }
2063    
 sub backup {  
     my($ssaD) = @_;  
   
     my $sz1 = &size("$ssaD/spreadsheet") + &size("$ssaD/notes");  
     my $sz2 = &size("$ssaD/spreadsheet~") + &size("$ssaD/notes~");  
     if (abs($sz1-$sz2) > 10)  
     {  
         &make_backup($ssaD);  
     }  
 }  
   
 sub make_backup {  
     my($ssaD) = @_;  
   
     &FIG::verify_dir("$ssaD/Backup");  
     my $ts = time;  
     rename("$ssaD/spreadsheet~","$ssaD/Backup/spreadsheet.$ts");  
     rename("$ssaD/notes~","$ssaD/Backup/notes.$ts");  
     &incr_version($ssaD);  
 }  
   
 sub incr_version {  
     my($dir) = @_;  
     my($ver);  
   
     if (open(VER,"<$dir/VERSION"))  
     {  
         if (defined($ver = <VER>) && ($ver =~ /^(\S+)/))  
         {  
             $ver = $1;  
         }  
         else  
         {  
             $ver = 0;  
         }  
         close(VER);  
     }  
     else  
     {  
         $ver = 0;  
     }  
     open(VER,">$dir/VERSION") || die "could not open $dir/VERSION";  
     chmod(0777,"$dir/VERSION");  
     $ver++;  
     print VER "$ver\n";  
 }  
   
   
 sub size {  
     my($file) = @_;  
   
     return (-s $file) ? -s $file : 0;  
 }  
   
2064  sub reset_ssa {  sub reset_ssa {
2065      my($fig,$cgi,$html) = @_;      my($fig,$cgi,$html) = @_;
2066      my($ssa,@spreadsheets,$col_hdrs,$tab,$t,$readable,$url,$link,@tmp);      my($ssa,@spreadsheets,$col_hdrs,$tab,$t,$readable,$url,$link,@tmp);
# Line 2102  Line 2110 
2110              system "cp -f $FIG_Config::data/Subsystems/$ssa/Backup/notes.$ts $FIG_Config::data/Subsystems/$ssa/notes";              system "cp -f $FIG_Config::data/Subsystems/$ssa/Backup/notes.$ts $FIG_Config::data/Subsystems/$ssa/notes";
2111              chmod(0777,"$FIG_Config::data/Subsystems/$ssa/notes");              chmod(0777,"$FIG_Config::data/Subsystems/$ssa/notes");
2112          }          }
2113          &reset_peg_subsystem_connections($fig,$ssa);  # you must break and restore connections of pegs to subsystem  
2114          push(@$html,$cgi->h1("Reset"));          my $subsystem = new Subsystem($ssa,$fig,0);
2115            $subsystem->db_sync(0);
2116            undef $subsystem;
2117      }      }
2118  }  }
2119    

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3