[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.2, Tue Jan 6 11:52:31 2004 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;
26  use DBI;  use DBI;
27  use FIG_Config;  use FIG_Config;
28    
# Line 8  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 $data_source = "DBI:$dbms(AutoCommit => 1):dbname=$dbname;port=$dbport";      return DBKernel::new($class, $dbms, $dbname, $dbuser, $dbpass, $dbport, $dbhost);
     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));  
43      }      }
44    
45      bless {  =head1 get_inserted_id
46          _dbh => $dbh,  
47          _dbms => $dbms,  Return the last ID of a row inserted into an autonumber/serial-containing table.
48          }, $class;  
49  }  =cut
50    
51  sub SQL {  sub get_inserted_id {
52      my($self,$sql,$verbose) = @_;      my($self, $table, $sth, $id_column) = @_;
     my($dbh,$sth,$rc,$tmp);  
53    
54      if ($verbose)      $id_column = 'id' unless defined($id_column);
55        if ($self->{_dbms} eq "Pg") {
56            my $oid = $sth->{pg_oid_status};
57            my $ret = $self->SQL("select $id_column from $table where oid = ?", undef, $oid);
58            return $ret->[0]->[0];
59        } elsif ($self->{_dbms} eq "mysql") {
60            my $id = $self->{_dbh}->{mysql_insertid};
61            # print "mysql got $id\n";
62            return $id;
63        }
64        else
65      {      {
66          print STDERR "running: $sql\n";          confess "Attempting get_inserted_id on unsupported database $self->{_dbms}\n";
67        }
68      }      }
69    
70      $dbh  = $self->{_dbh};  #
71    # Following are database administration routines. They create an instance of a ServerAdmin class
72    # for the appropriate server type (in order to eliminate the if mysql / if pg / etc stuff).
73    #
74    
75      if (($sql =~ /^select/i) && ($tmp = $dbh->selectall_arrayref($sql)))  sub get_server_admin
76    {
77        if ($FIG_Config::dbms eq "mysql")
78      {      {
79          return $tmp;          return MysqlAdmin->new();
80      }      }
81      else      elsif ($FIG_Config::dbms eq "Pg")
82      {      {
83          return $dbh->do($sql);          return new PostgresAdmin();
 #       $sth = $dbh->prepare($sql)  
 #           or die "prepare failed: $DBI::errstr";  
 #       $sth->execute()  
 #           or warn "execute failed: $DBI::errstr";  
 #       return 1;  
84      }      }
85        else
86        {
87            warn "Unknown server type $FIG_Config::dbms\n";
88      return undef;      return undef;
89  }  }
90    }
91    package MysqlAdmin;
92    
93    use POSIX;
94    use DBI;
95    
96    sub new
97    {
98        my($class) = @_;
99    
100        my $self = {};
101    
102        return bless($self, $class);
103    }
104    
105    sub init_db
106    {
107        my($self, $db_dir) = @_;
108    
109  sub drop_table {      if (!$db_dir)
110      my $self = shift @_;      {
111      my %arg  = @_;          warn "init_db failed: db_dir must be provided\n";
112      my $tbl  = $arg{tbl};          return;
     my $dbh  = $self->{_dbh};  
     my $dbms = $self->{_dbms};  
     my $cmd;  
     if ($dbms eq "mysql")  { $cmd = "DROP TABLE IF EXISTS $tbl;" ; }  
     else                   { $cmd = "DROP TABLE $tbl;" ; }  
     $dbh->do($cmd);  
113  }  }
114    
115  sub create_table {      if (-d "$db_dir/mysql")
116      my $self = shift @_;      {
117      my %arg  = @_;          warn "init_db: mysql data directory already exists\n";
118      my $tbl  = $arg{tbl};          return;
     my $flds = $arg{flds};  
     my $dbh  = $self->{_dbh};  
     my $dbms = $self->{_dbms};  
     $dbh->do("CREATE TABLE $tbl ( $flds );");  
119  }  }
120    
121  sub load_table {      my $exe = "$FIG_Config::ext_bin/mysql_install_db";
122      my $self     = shift @_;      if (! -x $exe)
123      my %defaults = ( delim => "\t" );      {
124      my %arg      = (%defaults, @_);          $exe = "mysql_install_db";
125      my $file     = $arg{file};      }
     my $tbl      = $arg{tbl};  
     my $delim    = $arg{delim};  
     my $dbh  = $self->{_dbh};  
     my $dbms = $self->{_dbms};  
126    
127      if ($file)      my $rc = system($exe,
128                        "--datadir=$db_dir",
129                        "--basedir=$FIG_Config::common_runtime",
130                        "--user=$FIG_Config::dbuser");
131        if ($rc != 0)
132      {      {
133          if ($dbms eq "mysql")          my $err = $?;
134            if (WIFEXITED($err))
135          {          {
136              $dbh->do("LOAD DATA LOCAL INFILE '$file' REPLACE INTO TABLE $tbl;");              my $exitstat = WEXITSTATUS($err);
137                warn "init_db failed: $exe returned result code $exitstat\n";
138          }          }
139          elsif ($dbms eq "Pg")          else
140          {          {
141              $dbh->do("COPY $tbl FROM '$file' USING DELIMITERS '$delim';");              warn "init_db failed: $exe died with signal ", WTERMSIG($err), "\n";
142          }          }
143            return;
144      }      }
145    
146        return 1;
147  }  }
148    
149  sub create_index {  sub create_database
     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")  
150      {      {
151          $cmd .= " USING $type ";      my($self, $db_name) = @_;
152      }  
153      $cmd .= " ( $flds );";      my $drh = DBI->install_driver("mysql");
154      $dbh->do($cmd);  
155        my @dbs = DBI->data_sources("mysql", { host => $FIG_Config::dbhost,
156                                                   user => $FIG_Config::dbuser,
157                                                   password => $FIG_Config::dbpass });
158        if (grep { $_ eq $db_name } @dbs)
159        {
160            warn "Database $db_name already exists\n";
161            return;
162  }  }
163    
164  sub DESTROY {      my $rc = $drh->func('createdb', $db_name, $FIG_Config::dbhost,
165      my($self) = @_;                          $FIG_Config::dbuser, $FIG_Config::dbpass, 'admin');
166    
167    
168      my($dbh);      if (!$rc)
     if ($dbh = $self->{_dbh})  
169      {      {
170          $dbh->disconnect;          warn "create_database: createdb call failed: $DBI::errstr\n";
171            return;
172        }
173    
174        return 1;
175      }      }
176    
177    sub start_server
178    {
179        my($self, $dont_fork) = @_;
180    
181        print "Starting mysql server\n";
182    
183        my(@opts);
184    
185        push(@opts, "--port=$FIG_Config::dbport");
186        #
187        # Don't do this; dbuser isn't the unix uid that we are using.
188        #
189        #push(@opts, "--user=$FIG_Config::dbuser");
190        push(@opts, "--basedir=$FIG_Config::common_runtime");
191        push(@opts, "--datadir=$FIG_Config::db_datadir");
192        push(@opts, "--ledir=$FIG_Config::common_runtime/libexec");
193        push(@opts, "--old-password");
194        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.
203        #
204        #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  sub vacuum_it {      #
212      my($self,@tables) = @_;      # We are going to assume that if mysql has shipped with this release, we'll use it. Otherwise
213      my($table);      # try to use a system one.
214        #
215    
216      my $dbh  = $self->{_dbh};      my $exe = "$FIG_Config::ext_bin/mysqld_safe";
217      my $dbms = $self->{_dbms};  
218      if ($dbms eq "mysql")      print "Start $exe @opts\n";
219        if (! -x $exe)
220      {      {
221          return;          $exe = "mysqld_safe";
222      }      }
223    
224      # this chunk is for Pg  (Postgres)      if ($dont_fork)
     if (@tables == 0)  
225      {      {
226          $self->SQL("VACUUM ANALYZE");          $ENV{MYSQL_TCP_PORT} = $FIG_Config::dbport;
227            exec $exe, @opts;
228      }      }
229      else      else
230      {      {
231          foreach $table (@tables)          my $pid = fork;
232    
233            if ($pid == 0)
234          {          {
235              $self->SQL("VACUUM ANALYZE $table");              POSIX::setsid();
236    
237                $ENV{MYSQL_TCP_PORT} = $FIG_Config::dbport;
238                exec $exe, @opts;
239          }          }
240            print "Forked db server $pid\n";
241      }      }
242    
243  }  }
244    
245  1  1;

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3