[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.69, Thu Sep 15 14:33:49 2005 UTC revision 1.70, Thu Sep 15 18:47:58 2005 UTC
# Line 205  Line 205 
205    
206      bless($self, $class);      bless($self, $class);
207    
208        #
209        # Check to see if the database we're running against has a variant column.
210        #
211        $self->detect_db_version();
212    
213      if ($create)      if ($create)
214      {      {
215          $self->create_subsystem();          $self->create_subsystem();
# Line 217  Line 222 
222      return $self;      return $self;
223  }  }
224    
225    sub detect_db_version
226    {
227        my($self) = @_;
228        my $db = $self->{fig}->db_handle();
229        my $dbh = $db->{_dbh};
230        local $dbh->{RaiseError} = 1;
231        local $dbh->{PrintError} = 0;
232    
233        eval {
234            my $x = $db->SQL("select variant from subsystem_index where subsystem = '' limit 1");
235        };
236    
237        #
238        # If this failed, it's an old database.
239        #
240        if ($@ =~ /variant/)
241        {
242            warn "Please rerun index_subsystems: current table does not have a variant column\n";
243            $self->{old_database} = 1;
244        }
245    }
246    
247    
248  sub new_from_dir  sub new_from_dir
249  {  {
250      my($class, $dir, $fig) = @_;      my($class, $dir, $fig) = @_;
# Line 672  Line 700 
700      # We run thru all the cells, writing an entry in the database for the peg/subsystem/role.      # We run thru all the cells, writing an entry in the database for the peg/subsystem/role.
701      #      #
702    
703      # my $sth = $rdbH->{_dbh}->prepare("INSERT INTO subsystem_index values(?, ?, ?)");      # my $sth = $rdbH->{_dbh}->prepare("INSERT INTO subsystem_index values(?, ?, ?, ?)");
704    
705      for my $role ($self->get_roles())      my @roles = $self->get_roles();
706        for my $genome ($self->get_genomes())
707      {      {
708          my $ridx = $self->get_role_index($role);          my $gidx = $self->get_genome_index($genome);
709          my $col = $self->get_col($ridx);          my $variant = $self->get_variant_code($gidx);
710          for my $cell (@$col)          print "Index $genome variant=$variant\n";
711            my $row = $self->get_row($gidx);
712    
713            for my $i (0..$#$row)
714          {          {
715                my $cell = $row->[$i];
716                my $role = $roles[$i];
717              if ($cell)              if ($cell)
718              {              {
719                  for my $peg (@$cell)                  for my $peg (@$cell)
720                  {                  {
721                      # $sth->execute($peg, $self->{name}, $role);                      # $sth->execute($peg, $self->{name}, $role);
722                        if ($self->{old_database})
723                        {
724                      print TMP "$peg\t$self->{name}\t$role\n";                      print TMP "$peg\t$self->{name}\t$role\n";
725                  }                  }
726                        else
727                        {
728                            print TMP "$peg\t$self->{name}\t$role\t$variant\n";
729                        }
730                    }
731              }              }
732          }          }
733      }      }
# Line 704  Line 745 
745    
746      my $rdbH = $self->{fig}->db_handle();      my $rdbH = $self->{fig}->db_handle();
747    
748      $rdbH->SQL("DELETE FROM subsystem_index where subsystem = '$self->{name}'")      $rdbH->SQL("DELETE FROM subsystem_index where subsystem = ?", undef, $self->{name});
749  }  }
750    
751  sub load  sub load
# Line 1347  Line 1388 
1388  {  {
1389      my($self, $gidx, $val) = @_;      my($self, $gidx, $val) = @_;
1390      $self->{variant_code}->[$gidx] = $val;      $self->{variant_code}->[$gidx] = $val;
1391    
1392        #
1393        # Update the index for all the pegs in this row.
1394        # (only if we have a new database)
1395        #
1396    
1397        if ($self->{old_database})
1398        {
1399            return;
1400        }
1401    
1402        my $rdbH = $self->{fig}->db_handle();
1403        my $dbh = $rdbH->{_dbh};
1404        my $cells = $self->get_row($gidx);
1405        my $sub_name = $self->{name};
1406    
1407        my $sth = $dbh->prepare(qq(UPDATE subsystem_index
1408                                   SET variant = ?
1409                                   WHERE (subsystem = ? AND
1410                                          role = ? AND
1411                                          protein = ?)
1412                                  ));
1413        for my $i (0 .. $#$cells)
1414        {
1415            my $cell = $cells->[$i];
1416            my $role = $self->get_role($i);
1417    
1418            for my $peg (@$cell)
1419            {
1420                $sth->execute($val, $sub_name, $role, $peg);
1421                warn "Update variant $sub_name $role $peg v='$val'\n";
1422            }
1423        }
1424    
1425      return;      return;
1426  }  }
1427    
# Line 1567  Line 1642 
1642      }      }
1643      my $cell = $self->get_cell($row, $col);      my $cell = $self->get_cell($row, $col);
1644    
1645    
1646      if (defined($cell))      if (defined($cell))
1647      {      {
1648            my $sub_name = $self->{name};
1649          my $peg;          my $peg;
1650          my $rdbH = $self->{fig}->db_handle();          my $rdbH = $self->{fig}->db_handle();
1651          my $roleQ = quotemeta $role;          my $dbh = $rdbH->{_dbh};
1652    
1653            my $variant = $self->get_variant_code($row);
1654    
1655          if (@$cell > 0)          if (@$cell > 0)
1656          {          {
1657                my $sth = $dbh->prepare(qq(DELETE FROM subsystem_index
1658                                           WHERE (subsystem = ? AND
1659                                                  role = ? AND
1660                                                  protein = ?)
1661                                           ));
1662              foreach $peg (@$cell)              foreach $peg (@$cell)
1663              {              {
1664                  $rdbH->SQL("DELETE FROM subsystem_index where ( subsystem = '$self->{name}' ) AND                  $sth->execute($sub_name, $role, $peg);
1665                                                                ( role = '$roleQ' ) AND                  warn "Deleting $sub_name $role $peg\n";
                                                               ( protein = '$peg' )" );  
1666              }              }
1667          }          }
1668    
1669          @$cell = @$peg_list;          @$cell = @$peg_list;
1670    
1671            if ($self->{old_database})
1672            {
1673                my $sth = $rdbH->{_dbh}->prepare(qq(INSERT INTO subsystem_index (protein,subsystem,role)
1674                                                    VALUES (?, ?, ?)));
1675                foreach $peg (@$cell)
1676                {
1677                    $sth->execute($peg, $sub_name, $role);
1678                    warn "Add old $peg $sub_name $role\n";
1679                }
1680            }
1681            else
1682            {
1683                my $sth = $rdbH->{_dbh}->prepare(qq(INSERT INTO subsystem_index (protein,subsystem,role,variant)
1684                                                    VALUES (?, ?, ?, ?)));
1685          foreach $peg (@$cell)          foreach $peg (@$cell)
1686          {          {
1687              $rdbH->SQL("INSERT INTO subsystem_index (protein,subsystem,role) VALUES ('$peg','$self->{name}','$roleQ' )");                  $sth->execute($peg, $sub_name, $role, $variant);
1688                    warn "Add new $peg $sub_name $role v='$variant'\n";
1689                }
1690          }          }
1691      }      }
1692      else      else
# Line 1893  Line 1994 
1994      my $old_roles = $self->{role_index};      my $old_roles = $self->{role_index};
1995    
1996      my @role_index_conversion;      my @role_index_conversion;
1997        my @old_role_list = @{$self->{roles}};
1998    
1999        #
2000        # Since we're setting up completely new roles, wipe the
2001        # existing state.
2002        #
2003    
2004      $self->{abbr} = {};      $self->{abbr} = {};
2005      $self->{role_index} = {};      $self->{role_index} = {};
2006      $self->{roles} = [];      $self->{roles} = [];
2007      $self->{role_abbrs} = [];      $self->{role_abbrs} = [];
2008    
2009        #
2010        # Initialize %defunct_roles with the list of all roles.
2011        # Remove entries as we walk the list of new roles below.
2012        # Any that are remaining need to be pulled from the index.
2013        #
2014    
2015        my %defunct_roles = map { $_ => 1 } @old_role_list;
2016    
2017        # warn "Defunct at start: ", Dumper(\%defunct_roles);
2018      for (my $idx = 0; $idx < @$roles; $idx++)      for (my $idx = 0; $idx < @$roles; $idx++)
2019      {      {
2020          my $role = $roles->[$idx]->[0];          my $role = $roles->[$idx]->[0];
# Line 1910  Line 2024 
2024    
2025          if (defined($old_idx))          if (defined($old_idx))
2026          {          {
2027  #           print "Found old idx $old_idx for $role $idx\n";              # warn "Found old idx $old_idx for $role $idx\n";
2028  #           print $oldssinv->[$old_idx];              # warn $oldssinv->[$old_idx];
2029              $ssinv->[$idx] = $oldssinv->[$old_idx];              $ssinv->[$idx] = $oldssinv->[$old_idx];
2030    
2031              $role_index_conversion[$old_idx] = $idx;              $role_index_conversion[$old_idx] = $idx;
2032    
2033                #
2034                # We're keeping it, so it's not defunct anymore.
2035                #
2036                delete $defunct_roles{$role};
2037          }          }
2038          else          else
2039          {          {
2040  #           print "Did not find old role for $role $idx\n";              # warn "Did not find old role for $role $idx\n";
2041  #           print Dumper($old_roles);              # warn Dumper($old_roles);
2042              my $l = [];              my $l = [];
2043              for (my $j = 0; $j < $ng; $j++)              for (my $j = 0; $j < $ng; $j++)
2044              {              {
# Line 1929  Line 2048 
2048              $ssinv->[$idx] = $l;              $ssinv->[$idx] = $l;
2049          }          }
2050    
2051    
2052          #          #
2053          # While we're here, update the new role and abbrev indexes          # While we're here, update the new role and abbrev indexes
2054          #          #
# Line 1939  Line 2059 
2059      }      }
2060    
2061      #      #
2062        # Now we delete the pegs showing up for the list of defunct roles.
2063        #
2064        # warn "Defunct at finish: ", Dumper(\%defunct_roles);
2065    
2066        my $rdbH = $self->{fig}->db_handle();
2067        my $dbh = $rdbH->{_dbh};
2068        my $sub_name = $self->{name};
2069    
2070        my $sth = $dbh->prepare(qq(DELETE FROM subsystem_index
2071                                   WHERE (subsystem = ? AND
2072                                          role = ? AND
2073                                          protein = ?)
2074                                  ));
2075    
2076    
2077        for my $defunct_role (keys(%defunct_roles))
2078        {
2079            my $defunct_role_idx = $old_roles->{$defunct_role};
2080            my $col = $oldssinv->[$defunct_role_idx];
2081            # warn "Handle defunct role $defunct_role idx=$defunct_role_idx\n", Dumper($col);
2082    
2083            for my $cell (@$col)
2084            {
2085                for my $peg (@$cell)
2086                {
2087                    $sth->execute($sub_name, $defunct_role, $peg);
2088                    warn "Deleting $sub_name $defunct_role $peg\n";
2089                }
2090            }
2091        }
2092    
2093    
2094        #
2095      # Now create the uninverted spreadsheet.      # Now create the uninverted spreadsheet.
2096      #      #
2097    
# Line 2056  Line 2209 
2209      }      }
2210    
2211      #      #
2212        # Update the index. Again, do this before removing roles
2213        # so we have full data to work with.
2214        # We walk the role's column of the spreadsheet removing pegs from the index.
2215        #
2216    
2217        my $rdbH = $self->{fig}->db_handle();
2218        my $dbh = $rdbH->{_dbh};
2219        my $sub_name = $self->{name};
2220    
2221        my $sth = $dbh->prepare(qq(DELETE FROM subsystem_index
2222                                   WHERE (subsystem = ? AND
2223                                          role = ? AND
2224                                          protein = ?)
2225                                  ));
2226        my $col = $self->get_col($idx);
2227        for my $cell (@$col)
2228        {
2229             for my $peg (@$cell)
2230             {
2231                $sth->execute($sub_name, $role, $peg);
2232                warn "Deleting $sub_name $role $peg\n";
2233             }
2234        }
2235    
2236        #
2237      # Remove from the roles list.      # Remove from the roles list.
2238      #      #
2239    
# Line 2066  Line 2244 
2244      delete $self->{role_index}->{$role};      delete $self->{role_index}->{$role};
2245      delete $self->{abbr}->{$abbr};      delete $self->{abbr}->{$abbr};
2246    
2247    
2248      #      #
2249      # Update the spreadsheet.      # Update the spreadsheet.
2250      # On the standard one, we have to go through all the rows removing      # On the standard one, we have to go through all the rows removing
# Line 2189  Line 2368 
2368      }      }
2369    
2370      #      #
2371        # Remove from database index (before we delete stuff from here,
2372        # so we have access to th e data structures).
2373        #
2374    
2375        my $rdbH = $self->{fig}->db_handle();
2376        my $dbh = $rdbH->{_dbh};
2377        my $cells = $self->get_row($idx);
2378        my $sub_name = $self->{name};
2379    
2380        my $sth = $dbh->prepare(qq(DELETE FROM subsystem_index
2381                                   WHERE (subsystem = ? AND
2382                                          role = ? AND
2383                                          protein = ?)
2384                                  ));
2385        for my $i (0 .. $#$cells)
2386        {
2387            my $cell = $cells->[$i];
2388            my $role = $self->get_role($i);
2389    
2390            for my $peg (@$cell)
2391            {
2392                $sth->execute($sub_name, $role, $peg);
2393                warn "Deleting $sub_name $role $peg\n";
2394            }
2395        }
2396    
2397        #
2398      # Remove from the genomes list.      # Remove from the genomes list.
2399      #      #
2400    

Legend:
Removed from v.1.69  
changed lines
  Added in v.1.70

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3