[Bio] / FigKernelPackages / Subsystem.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/Subsystem.pm

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

revision 1.30, Wed Sep 1 18:39:23 2004 UTC revision 1.31, Tue Sep 7 02:54:16 2004 UTC
# Line 1  Line 1 
   
1  package Subsystem;  package Subsystem;
2    
3  use Carp;  use Carp;
# Line 155  Line 154 
154    
155  =item get_subset(name)  =item get_subset(name)
156    
157    A deprecated form of get_subsetC
158    
159    =item get_subsetC(name)
160    
161  Returns a given subset. A subset is an object, implemented as a blessed array  Returns a given subset. A subset is an object, implemented as a blessed array
162  of roles.  of roles.
163    
# Line 282  Line 285 
285      $self->{col_subsets} = [];      $self->{col_subsets} = [];
286      $self->{col_subset_members} = {};      $self->{col_subset_members} = {};
287    
288        $self->{row_subsets} = [];
289        $self->{row_subset_members} = {};
290    
291      $self->{row_active_subset} = "All";      $self->{row_active_subset} = "All";
292      $self->{col_active_subset} = "All";      $self->{col_active_subset} = "All";
293    
# Line 693  Line 699 
699          open($fh, ">$ss_file") or die "Cannot open $ss_file for writing: $!\n";          open($fh, ">$ss_file") or die "Cannot open $ss_file for writing: $!\n";
700          $self->write_spreadsheet($fh);          $self->write_spreadsheet($fh);
701          close($fh);          close($fh);
702            chmod(0777,$ss_file);
703    
704          open($fh, ">$notes_file") or die "Cannot open $notes_file for writing: $!\n";          open($fh, ">$notes_file") or die "Cannot open $notes_file for writing: $!\n";
705          print $fh "$self->{notes}\n";          print $fh "$self->{notes}\n";
706          close($fh);          close($fh);
707            chmod(0777,$notes_file);
708    
709          $self->update_curation_log();          $self->update_curation_log();
710    
# Line 707  Line 715 
715          open($fh, ">$dir/EXCHANGABLE") or die "Cannot write $dir/EXCHANGABLE: $!\n";          open($fh, ">$dir/EXCHANGABLE") or die "Cannot write $dir/EXCHANGABLE: $!\n";
716          print $fh "$self->{exchangable}\n";          print $fh "$self->{exchangable}\n";
717          close($fh);          close($fh);
718            chmod(0777,"EXCHANGABLE");
719    
720          #          #
721          # Process backup files. This is the smae process that determines when the          # Process backup files. This is the smae process that determines when the
# Line 718  Line 727 
727          open($fh, ">$dir/VERSION") or die "Cannot write $dir/EXCHANGABLE: $!\n";          open($fh, ">$dir/VERSION") or die "Cannot write $dir/EXCHANGABLE: $!\n";
728          print $fh "$self->{exchangable}\n";          print $fh "$self->{exchangable}\n";
729          close($fh);          close($fh);
730            chmod(0777,"VERSION");
731      };      };
732    
733      if ($@ ne "")      if ($@ ne "")
# Line 833  Line 842 
842  {  {
843      my($self, $fh) = @_;      my($self, $fh) = @_;
844    
845      for my $sub ($self->get_subset_names())      for my $sub ($self->get_subset_namesC())
846      {      {
847          my @members= $self->get_subset($sub);          my @members= $self->get_subsetC($sub);
848    
849          #          #
850          # member list on disk is 1-based          # member list on disk is 1-based
# Line 1130  Line 1139 
1139          $row = $rowstr;          $row = $rowstr;
1140      }      }
1141    
1142      if (!$row)      if (! defined($row))
1143      {      {
1144          warn "Cannot find row for $rowstr\n";          warn "Cannot find row for $rowstr\n";
1145          return undef;          return undef;
# Line 1156  Line 1165 
1165          $col = $colstr;          $col = $colstr;
1166      }      }
1167    
1168      if (!$col)      if (! defined($col))
1169      {      {
1170          warn "Cannot find col for $colstr\n";          warn "Cannot find col for $colstr\n";
1171          return undef;          return undef;
# Line 1211  Line 1220 
1220  {  {
1221      my($self) = @_;      my($self) = @_;
1222    
1223        return $self->get_subset_namesC;
1224    }
1225    
1226    sub get_subset_namesC
1227    {
1228        my($self) = @_;
1229    
1230      return @{$self->{col_subsets}};      return @{$self->{col_subsets}};
1231  }  }
1232    
1233  sub get_subset  sub get_subset_namesR
1234    {
1235        my($self) = @_;
1236    
1237        return @{$self->{col_subsets}};
1238    }
1239    
1240    sub get_subsetC
1241  {  {
1242      my($self, $subname) = @_;      my($self, $subname) = @_;
1243        if ($subname eq "All") { return $self->get_roles }
1244    
1245      return @{$self->{col_subset_members}->{$subname}};      return @{$self->{col_subset_members}->{$subname}};
1246  }  }
1247    
1248    sub get_subset
1249    {
1250        my($self, $subname) = @_;
1251        return $self->subsetC($subname);
1252    }
1253    
1254    sub get_subsetR
1255    {
1256        my($self, $subname) = @_;
1257        my($pair,$id,$members,$genome);
1258    
1259        if ($subname eq "All") { return $self->get_genomes }
1260    
1261        $members = $self->{row_subset_members}->{$subname};
1262        if (! $members)
1263        {
1264            my $taxonomic_groups = $self->{fig}->taxonomic_groups_of_complete(10);
1265            foreach $pair (@$taxonomic_groups)
1266            {
1267                ($id,$members) = @$pair;
1268                push(@{$self->{row_subsets}},$id);
1269                $self->{row_subset_members}->{$id} = $members;
1270            }
1271            $members = $self->{row_subset_members}->{$subname};
1272        }
1273        return @$members;
1274    }
1275    
1276  =pod  =pod
1277    
1278  =head2 set_subset($name, $members)  =head2 set_subsetC($name, $members)
1279    
1280  Create a subset with the given name and members.  Create a subset with the given name and members.
1281    
# Line 1230  Line 1283 
1283    
1284  =cut  =cut
1285    
1286  sub set_subset  sub set_subsetC
1287  {  {
1288      my($self, $subname, $list) = @_;      my($self, $subname, $list) = @_;
1289    
# Line 1239  Line 1292 
1292      $self->_set_subset($subname, $nl);      $self->_set_subset($subname, $nl);
1293  }  }
1294    
1295    sub set_subset
1296    {
1297        my($self, $subname, $list) = @_;
1298    
1299        $self->set_subsetsC($subname,$list);
1300    }
1301    
1302  =pod  =pod
1303    
1304  =head2 _set_subset($name, $members)  =head2 _set_subset($name, $members)
# Line 1310  Line 1370 
1370    
1371          if (defined($old_idx))          if (defined($old_idx))
1372          {          {
1373              print "Found old idx $old_idx for $role $idx\n";  #           print "Found old idx $old_idx for $role $idx\n";
1374              print $oldssinv->[$old_idx];  #           print $oldssinv->[$old_idx];
1375              $ssinv->[$idx] = $oldssinv->[$old_idx];              $ssinv->[$idx] = $oldssinv->[$old_idx];
1376    
1377              $role_index_conversion[$old_idx] = $idx;              $role_index_conversion[$old_idx] = $idx;

Legend:
Removed from v.1.30  
changed lines
  Added in v.1.31

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3