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

Diff of /FigKernelPackages/DBrtns.pm

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

revision 1.12, Fri Apr 8 08:32:10 2005 UTC revision 1.25, Tue Jan 3 20:52:38 2006 UTC
# Line 1  Line 1 
1    #
2    # Copyright (c) 2003-2006 University of Chicago and Fellowship
3    # for Interpretations of Genomes. All Rights Reserved.
4    #
5    # This file is part of the SEED Toolkit.
6    #
7    # The SEED Toolkit is free software. You can redistribute
8    # it and/or modify it under the terms of the SEED Toolkit
9    # Public License.
10    #
11    # You should have received a copy of the SEED Toolkit Public License
12    # along with this program; if not write to the University of Chicago
13    # at info@ci.uchicago.edu or the Fellowship for Interpretation of
14    # Genomes at veronika@thefig.info or download a copy from
15    # http://www.theseed.org/LICENSE.TXT.
16    #
17    
18  package DBrtns;  package DBrtns;
19    
20        # Inherit the DBKernel methods. We must do this BEFORE the "use strict".
21        use DBKernel;
22        @ISA = qw(DBKernel);
23    
24  use strict;  use strict;
25  use POSIX;  use POSIX;
26  use DBI;  use DBI;
# Line 9  Line 30 
30  use Carp;  use Carp;
31    
32  sub new {  sub new {
33      my($class,$dbms,$dbname,$dbuser,$dbpass,$dbport) = @_;      my($class,$dbms,$dbname,$dbuser,$dbpass,$dbport, $dbhost) = @_;
34    
35      $dbms   = defined($dbms)   ? $dbms   : $FIG_Config::dbms;      $dbms   = defined($dbms)   ? $dbms   : $FIG_Config::dbms;
36      $dbname = defined($dbname) ? $dbname : $FIG_Config::db;      $dbname = defined($dbname) ? $dbname : $FIG_Config::db;
37      $dbuser = defined($dbuser) ? $dbuser : $FIG_Config::dbuser;      $dbuser = defined($dbuser) ? $dbuser : $FIG_Config::dbuser;
38      $dbpass = defined($dbpass) ? $dbpass : $FIG_Config::dbpass;      $dbpass = defined($dbpass) ? $dbpass : $FIG_Config::dbpass;
     $dbpass = defined($dbpass) ? $dbpass : $FIG_Config::dbpass;  
39      $dbport = defined($dbport) ? $dbport : $FIG_Config::dbport;      $dbport = defined($dbport) ? $dbport : $FIG_Config::dbport;
40        $dbhost = defined($dbhost) ? $dbhost : $FIG_Config::dbhost;
41    
42      my @opts;      return DBKernel::new($class, $dbms, $dbname, $dbuser, $dbpass, $dbport, $dbhost);
   
     push(@opts, "port=${dbport}");  
   
     #  
     # Late-model mysql needs to have the client enable loading from local files.  
     #  
   
     if ($dbms eq "mysql")  
     {  
         push(@opts, "mysql_local_infile=1");  
43      }      }
44    
     my $opts = join(";", @opts);  
     my $data_source = "DBI:$dbms(AutoCommit => 1):dbname=$dbname;$opts";  
     my $dbh         = DBI->connect( $data_source, $dbuser, $dbpass )  
         || die "ERROR: Could not connect to $data_source; ", DBI->errstr, "\n";  
     $dbh->{PrintError} = 1;  
     $dbh->{RaiseError} = 0;  
     if ($dbms eq "Pg")  
     {  
         $dbh->do(qq(SET "ENABLE_SEQSCAN" TO "OFF"));  
         $dbh->do(qq(SET DATESTYLE TO Postgres,US));  
     }  
   
     bless {  
         _dbh => $dbh,  
         _dbms => $dbms,  
         }, $class;  
 }  
   
 sub set_raise_exceptions  
 {  
     my($self, $enable) = @_;  
     my $dbh = $self->{_dbh};  
     my $old = $dbh->{RaiseError};  
     $dbh->{RaiseError} = $enable;  
     return $old;  
 }  
   
 sub SQL {  
     my($self, $sql, $verbose, @bind_values) = @_;  
     my($dbh,$sth,$rc,$tmp);  
   
     if ($verbose)  
     {  
         print STDERR "running: $sql\n";  
     }  
   
     $dbh  = $self->{_dbh};  
   
     if ($sql =~ /^\s*select/i)  
     {  
         my $ok = eval {  
             $tmp = $dbh->selectall_arrayref($sql, undef, @bind_values);  
         };  
         if (!$ok)  
         {  
             confess "Try running 'load_links' and 'load_attributes' to fix this error:\n$@";  
             #print STDERR "DBrtns.pm error: SQL $sql failed\n";  
             #return;  
         }  
         return $tmp;  
     }  
     else  
     {  
         my $rc;  
         my $ok = eval {  
             $rc = $dbh->do($sql, undef, @bind_values);  
         };  
   
         if (!$ok)  
         {  
             confess "query failed: " . substr($sql, 0, 100) . ": $@";  
         }  
         return $rc;  
   
   
 #       $sth = $dbh->prepare($sql)  
 #           or die "prepare failed: $DBI::errstr";  
 #       $sth->execute()  
 #           or warn "execute failed: $DBI::errstr";  
 #       return 1;  
     }  
     return undef;  
 }  
   
 sub get_tables  
 {  
     my($self) = @_;  
   
     my $dbh = $self->{_dbh};  
   
     my $quote = $dbh->get_info(29); # SQL_IDENTIFIER_QUOTE_CHAR  
   
     my @tables = $dbh->tables();  
   
     return map { $quote ne "" && s/^$quote(.*)$quote$/$1/; s/^[^.]+\.//; $_ } @tables;  
 }  
   
 sub table_exists  
 {  
     my($self, $table) = @_;  
   
     return (grep { $table eq $_ } $self->get_tables()) > 0;  
 }  
   
 sub drop_table {  
     my $self = shift @_;  
     my %arg  = @_;  
     my $tbl  = $arg{tbl};  
     my $dbh  = $self->{_dbh};  
     my $dbms = $self->{_dbms};  
     my $cmd;  
   
   
     if ($dbms eq "mysql")  
     {  
         $cmd = "DROP TABLE IF EXISTS $tbl;" ;  
     }  
     elsif ($dbms eq "Pg")  
     {  
         if ($self->table_exists($tbl))  
         {  
             $cmd = "DROP TABLE $tbl CASCADE;" ;  
         }  
     }  
     else  
     {  
         if ($self->table_exists($tbl))  
         {  
             $cmd = "DROP TABLE $tbl;" ;  
         }  
     }  
     if ($cmd)  
     {  
         $dbh->do($cmd);  
     }  
 }  
   
 sub create_table {  
     my $self = shift @_;  
     my %arg  = @_;  
     my $tbl  = $arg{tbl};  
     my $flds = $arg{flds};  
     my $dbh  = $self->{_dbh};  
     my $dbms = $self->{_dbms};  
     $dbh->do("CREATE TABLE $tbl ( $flds );");  
 }  
   
 sub load_table {  
     my $self     = shift @_;  
     my %defaults = ( delim => "\t" );  
     my %arg      = (%defaults, @_);  
     my $file     = $arg{file};  
     my $tbl      = $arg{tbl};  
     my $delim    = $arg{delim};  
     my $dbh  = $self->{_dbh};  
     my $dbms = $self->{_dbms};  
   
     if ($file)  
     {  
         if ($dbms eq "mysql")  
         {  
             $dbh->do("LOAD DATA LOCAL INFILE '$file' REPLACE INTO TABLE $tbl;");  
         }  
         elsif ($dbms eq "Pg")  
         {  
             $dbh->do("COPY $tbl FROM '$file' USING DELIMITERS '$delim';");  
         }  
     }  
 }  
   
 sub create_index {  
     my $self = shift @_;  
     my %arg  = @_;  
     my $tbl  = $arg{tbl};  
     my $idx  = $arg{idx};  
     my $flds = $arg{flds};  
     my $type = $arg{type};  
     my $dbh  = $self->{_dbh};  
     my $dbms = $self->{_dbms};  
     my $cmd  = "CREATE INDEX $idx ON $tbl ";  
     if ($type && $dbms eq "Pg")  
     {  
         $cmd .= " USING $type ";  
     }  
     $cmd .= " ( $flds );";  
     $dbh->do($cmd);  
 }  
   
 sub DESTROY {  
     my($self) = @_;  
   
     my($dbh);  
     if ($dbh = $self->{_dbh})  
     {  
         $dbh->disconnect;  
     }  
 }  
   
 sub vacuum_it {  
     my($self,@tables) = @_;  
     my($table);  
   
     my $dbh  = $self->{_dbh};  
     my $dbms = $self->{_dbms};  
     if ($dbms eq "mysql")  
     {  
         return;  
     }  
   
     # this chunk is for Pg  (Postgres)  
     if (@tables == 0)  
     {  
         $self->SQL("VACUUM ANALYZE");  
     }  
     else  
     {  
         foreach $table (@tables)  
         {  
             $self->SQL("VACUUM ANALYZE $table");  
         }  
     }  
 }  
   
 =pod  
   
45  =head1 get_inserted_id  =head1 get_inserted_id
46    
47  Return the last ID of a row inserted into an autonumber/serial-containing table.  Return the last ID of a row inserted into an autonumber/serial-containing table.
48    
49  =cut  =cut
50    
51  sub get_inserted_id  sub get_inserted_id {
52  {      my($self, $table, $sth, $id_column) = @_;
53      my($self, $table, $sth) = @_;  
54      if ($self->{_dbms} eq "Pg")      $id_column = 'id' unless defined($id_column);
55      {      if ($self->{_dbms} eq "Pg") {
56          my $oid = $sth->{pg_oid_status};          my $oid = $sth->{pg_oid_status};
57          my $ret = $self->SQL("select id from $table where oid = ?", undef, $oid);          my $ret = $self->SQL("select $id_column from $table where oid = ?", undef, $oid);
58          return $ret->[0]->[0];          return $ret->[0]->[0];
59      }      } elsif ($self->{_dbms} eq "mysql") {
     elsif ($self->{_dbms} eq "mysql")  
     {  
60          my $id = $self->{_dbh}->{mysql_insertid};          my $id = $self->{_dbh}->{mysql_insertid};
61          # print "mysql got $id\n";          # print "mysql got $id\n";
62          return $id;          return $id;
63      }      }
64        else
65        {
66            confess "Attempting get_inserted_id on unsupported database $self->{_dbms}\n";
67        }
68  }  }
   
69    
70  #  #
71  # Following are database administration routines. They create an instance of a ServerAdmin class  # Following are database administration routines. They create an instance of a ServerAdmin class
# Line 329  Line 126 
126    
127      my $rc = system($exe,      my $rc = system($exe,
128                      "--datadir=$db_dir",                      "--datadir=$db_dir",
129                        "--basedir=$FIG_Config::common_runtime",
130                      "--user=$FIG_Config::dbuser");                      "--user=$FIG_Config::dbuser");
131      if ($rc != 0)      if ($rc != 0)
132      {      {
# Line 378  Line 176 
176    
177  sub start_server  sub start_server
178  {  {
179      my($self) = @_;      my($self, $dont_fork) = @_;
180    
181      print "Starting mysql server\n";      print "Starting mysql server\n";
182    
# Line 395  Line 193 
193      push(@opts, "--old-password");      push(@opts, "--old-password");
194      push(@opts, "--max-allowed-packet=128M");      push(@opts, "--max-allowed-packet=128M");
195      #      #
196        # Use InnoDB for large-table support and allegedly better performance.
197        #
198    
199        #push(@opts, "--default-table-type=innodb");
200    
201        #
202      # Oddly, this doesn't seem to work. need to set the environment variable.      # Oddly, this doesn't seem to work. need to set the environment variable.
203      #      #
204      #push(@opts, "--port=$FIG_Config::dbport");      #push(@opts, "--port=$FIG_Config::dbport");
205    
206        if (@FIG_Config::db_server_startup_options)
207        {
208            push(@opts, @FIG_Config::db_server_startup_options)
209        }
210    
211      #      #
212      # We are going to assume that if mysql has shipped with this release, we'll use it. Otherwise      # We are going to assume that if mysql has shipped with this release, we'll use it. Otherwise
213      # try to use a system one.      # try to use a system one.
214      #      #
215    
216      my $exe = "$FIG_Config::ext_bin/mysqld_safe";      my $exe = "$FIG_Config::ext_bin/mysqld_safe";
217    
218        print "Start $exe @opts\n";
219      if (! -x $exe)      if (! -x $exe)
220      {      {
221          $exe = "mysqld_safe";          $exe = "mysqld_safe";
222      }      }
223    
224        if ($dont_fork)
225        {
226            $ENV{MYSQL_TCP_PORT} = $FIG_Config::dbport;
227            exec $exe, @opts;
228        }
229        else
230        {
231      my $pid = fork;      my $pid = fork;
232    
233      if ($pid == 0)      if ($pid == 0)
# Line 419  Line 237 
237          $ENV{MYSQL_TCP_PORT} = $FIG_Config::dbport;          $ENV{MYSQL_TCP_PORT} = $FIG_Config::dbport;
238          exec $exe, @opts;          exec $exe, @opts;
239      }      }
   
240      print "Forked db server $pid\n";      print "Forked db server $pid\n";
241  }  }
242    
243    }
244    
245  1  1;

Legend:
Removed from v.1.12  
changed lines
  Added in v.1.25

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3