[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.4, Wed Oct 27 15:04:10 2004 UTC revision 1.27, Thu Mar 2 22:19:45 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, $dbsock) = @_;
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        $dbsock = defined($dbsock) ? $dbsock : $FIG_Config::dbsock;
42    
43      my @opts;      return DBKernel::new($class, $dbms, $dbname, $dbuser, $dbpass, $dbport, $dbhost, $dbsock);
44    }
45    
46    =head1 get_inserted_id
47    
48    Return the last ID of a row inserted into an autonumber/serial-containing table.
49    
50      push(@opts, "port=${dbport}");  =cut
51    
52    sub get_inserted_id {
53        my($self, $table, $sth, $id_column) = @_;
54    
55        $id_column = 'id' unless defined($id_column);
56        if ($self->{_dbms} eq "Pg") {
57            my $oid = $sth->{pg_oid_status};
58            my $ret = $self->SQL("select $id_column from $table where oid = ?", undef, $oid);
59            return $ret->[0]->[0];
60        } elsif ($self->{_dbms} eq "mysql") {
61            my $id = $self->{_dbh}->{mysql_insertid};
62            # print "mysql got $id\n";
63            return $id;
64        }
65        else
66        {
67            confess "Attempting get_inserted_id on unsupported database $self->{_dbms}\n";
68        }
69    }
70    
71      #      #
72      # Late-model mysql needs to have the client enable loading from local files.  # Following are database administration routines. They create an instance of a ServerAdmin class
73    # for the appropriate server type (in order to eliminate the if mysql / if pg / etc stuff).
74      #      #
75    
76      if ($dbms eq "mysql")  sub get_server_admin
77    {
78        if ($FIG_Config::dbms eq "mysql")
79        {
80            return MysqlAdmin->new();
81        }
82        elsif ($FIG_Config::dbms eq "Pg")
83        {
84            return new PostgresAdmin();
85        }
86        else
87        {
88            warn "Unknown server type $FIG_Config::dbms\n";
89            return undef;
90        }
91    }
92    package MysqlAdmin;
93    
94    use POSIX;
95    use DBI;
96    
97    sub new
98      {      {
99          push(@opts, "mysql_local_infile=1");      my($class) = @_;
100    
101        my $self = {};
102    
103        return bless($self, $class);
104      }      }
105    
106      my $opts = join(";", @opts);  sub init_db
107      my $data_source = "DBI:$dbms(AutoCommit => 1):dbname=$dbname;$opts";  {
108      my $dbh         = DBI->connect( $data_source, $dbuser, $dbpass )      my($self, $db_dir) = @_;
109          || die "ERROR: Could not connect to $data_source; ", DBI->errstr, "\n";  
110      $dbh->{PrintError} = 1;      if (!$db_dir)
     $dbh->{RaiseError} = 0;  
     if ($dbms eq "Pg")  
111      {      {
112          $dbh->do(qq(SET "ENABLE_SEQSCAN" TO "OFF"));          warn "init_db failed: db_dir must be provided\n";
113          $dbh->do(qq(SET DATESTYLE TO Postgres,US));          return;
114      }      }
115    
116      bless {      if (-d "$db_dir/mysql")
117          _dbh => $dbh,      {
118          _dbms => $dbms,          warn "init_db: mysql data directory already exists\n";
119          }, $class;          return;
120  }  }
121    
122  sub set_raise_exceptions      my $exe = "$FIG_Config::ext_bin/mysql_install_db";
123        if (! -x $exe)
124  {  {
125      my($self, $enable) = @_;          $exe = "mysql_install_db";
     my $dbh = $self->{_dbh};  
     my $old = $dbh->{RaiseError};  
     $dbh->{RaiseError} = $enable;  
     return $old;  
126  }  }
127    
 sub SQL {  
     my($self,$sql,$verbose) = @_;  
     my($dbh,$sth,$rc,$tmp);  
128    
129      if ($verbose)      my @opts;
130    
131        push(@opts, "--datadir=$db_dir");
132        push(@opts, "--user=$FIG_Config::dbuser");
133    
134        if (not $FIG_Config::use_system_mysql)
135      {      {
136          print STDERR "running: $sql\n";          push(@opts, "--basedir=$FIG_Config::common_runtime")
137      }      }
138    
     $dbh  = $self->{_dbh};  
139    
140      if ($sql =~ /^select/i)      my $rc = system($exe, @opts);
141        if ($rc != 0)
142      {      {
143          $tmp = $dbh->selectall_arrayref($sql);          my $err = $?;
144          return $tmp;          if (WIFEXITED($err))
145            {
146                my $exitstat = WEXITSTATUS($err);
147                warn "init_db failed: $exe returned result code $exitstat\n";
148      }      }
149      else      else
150      {      {
151          return $dbh->do($sql);              warn "init_db failed: $exe died with signal ", WTERMSIG($err), "\n";
 #       $sth = $dbh->prepare($sql)  
 #           or die "prepare failed: $DBI::errstr";  
 #       $sth->execute()  
 #           or warn "execute failed: $DBI::errstr";  
 #       return 1;  
152      }      }
153      return undef;          return;
154  }  }
155    
156  sub get_tables      return 1;
157    }
158    
159    sub create_database
160    {
161        my($self, $db_name) = @_;
162    
163        my $drh = DBI->install_driver("mysql");
164    
165        my @dbs = DBI->data_sources("mysql", { host => $FIG_Config::dbhost,
166                                                   user => $FIG_Config::dbuser,
167                                                   password => $FIG_Config::dbpass });
168        if (grep { $_ eq $db_name } @dbs)
169  {  {
170      my($self) = @_;          warn "Database $db_name already exists\n";
171            return;
172        }
173    
174      my $dbh = $self->{_dbh};      my $rc = $drh->func('createdb', $db_name, $FIG_Config::dbhost,
175                            $FIG_Config::dbuser, $FIG_Config::dbpass, 'admin');
176    
     my $quote = $dbh->get_info(29); # SQL_IDENTIFIER_QUOTE_CHAR  
177    
178      my @tables = $dbh->tables();      if (!$rc)
179        {
180            warn "create_database: createdb call failed: $DBI::errstr\n";
181            return;
182        }
183    
184      return map { $quote ne "" && s/^$quote(.*)$quote$/$1/; s/^[^.]+\.//; $_ } @tables;      return 1;
185  }  }
186    
187  sub table_exists  sub start_server
188  {  {
189      my($self, $table) = @_;      my($self, $dont_fork) = @_;
190    
191      return (grep { $table eq $_ } $self->get_tables()) > 0;      print "Starting mysql server\n";
 }  
192    
193  sub drop_table {      my(@opts);
     my $self = shift @_;  
     my %arg  = @_;  
     my $tbl  = $arg{tbl};  
     my $dbh  = $self->{_dbh};  
     my $dbms = $self->{_dbms};  
     my $cmd;  
194    
195        my $cnf = "$FIG_Config::fig_disk/config/my.cnf";
196    
197      if ($dbms eq "mysql")      if ($FIG_Config::use_system_mysql)
     {  
         $cmd = "DROP TABLE IF EXISTS $tbl;" ;  
     }  
     else  
     {  
         if ($self->table_exists($tbl))  
198          {          {
199              $cmd = "DROP TABLE $tbl;" ;          #
200          }          # This has to be first in the argument list.
201            #
202            push(@opts, "--defaults-extra-file=$cnf");
203      }      }
204      if ($cmd)  
205        #
206        # Put this first, so  config can put --defaults-extra-file here
207        # and have it show up first.
208        #
209        if (@FIG_Config::db_server_startup_options)
210      {      {
211          $dbh->do($cmd);          push(@opts, @FIG_Config::db_server_startup_options)
     }  
212  }  }
213    
214  sub create_table {      push(@opts, "--port=$FIG_Config::dbport");
215      my $self = shift @_;      #
216      my %arg  = @_;      # Don't do this; dbuser isn't the unix uid that we are using.
217      my $tbl  = $arg{tbl};      #
218      my $flds = $arg{flds};      #push(@opts, "--user=$FIG_Config::dbuser");
219      my $dbh  = $self->{_dbh};  
220      my $dbms = $self->{_dbms};      push(@opts, "--datadir=$FIG_Config::db_datadir");
221      $dbh->do("CREATE TABLE $tbl ( $flds );");  
222  }      if ($FIG_Config::use_system_mysql)
223        {
224            push(@opts, "--err-log=$FIG_Config::temp/mysql.log");
225            push(@opts, "--socket=$FIG_Config::dbsock");
226    
227  sub load_table {          #
228      my $self     = shift @_;          # Feh. You can't actually override the socket that /etc/my.cnf
229      my %defaults = ( delim => "\t" );          # sets up, so we need to set up a config/my.cnf with the socket in it.
230      my %arg      = (%defaults, @_);          #
     my $file     = $arg{file};  
     my $tbl      = $arg{tbl};  
     my $delim    = $arg{delim};  
     my $dbh  = $self->{_dbh};  
     my $dbms = $self->{_dbms};  
231    
232      if ($file)          if (! -f $cnf)
233      {      {
234          if ($dbms eq "mysql")              if (open(F, ">$cnf"))
235          {          {
236              $dbh->do("LOAD DATA LOCAL INFILE '$file' REPLACE INTO TABLE $tbl;");                  print F <<END;
237    [mysqld]
238    socket=$FIG_Config::dbsock
239    END
240                    close(F);
241          }          }
         elsif ($dbms eq "Pg")  
         {  
             $dbh->do("COPY $tbl FROM '$file' USING DELIMITERS '$delim';");  
242          }          }
243      }      }
244        else
245        {
246            push(@opts, "--basedir=$FIG_Config::common_runtime");
247            push(@opts, "--ledir=$FIG_Config::common_runtime/libexec");
248  }  }
249    
250  sub create_index {      if (not $FIG_Config::mysql_v3)
     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")  
251      {      {
252          $cmd .= " USING $type ";          push(@opts, "--old-password");
253      }          push(@opts, "--max-allowed-packet=128M");
     $cmd .= " ( $flds );";  
     $dbh->do($cmd);  
254  }  }
255    
256  sub DESTROY {      #
257      my($self) = @_;      # Use InnoDB for large-table support and allegedly better performance.
258        #
259    
260        #push(@opts, "--default-table-type=innodb");
261    
262        #
263        # Oddly, this doesn't seem to work. need to set the environment variable.
264        #
265        #push(@opts, "--port=$FIG_Config::dbport");
266    
267        #
268        # We are going to assume that if mysql has shipped with this release, we'll use it. Otherwise
269        # try to use a system one.
270        #
271    
272      my($dbh);      my $exe;
273      if ($dbh = $self->{_dbh})      if ($FIG_Config::mysql_v3)
274      {      {
275          $dbh->disconnect;          $exe = "safe_mysqld";
276      }      }
277        else
278        {
279            $exe = "mysqld_safe";
280  }  }
281    
282  sub vacuum_it {      if (-x "$FIG_Config::ext_bin/$exe")
     my($self,@tables) = @_;  
     my($table);  
   
     my $dbh  = $self->{_dbh};  
     my $dbms = $self->{_dbms};  
     if ($dbms eq "mysql")  
283      {      {
284          return;          $exe = "$FIG_Config::ext_bin/$exe";
285      }      }
286    
287      # this chunk is for Pg  (Postgres)      print "Start $exe @opts\n";
288      if (@tables == 0)  
289        if ($dont_fork)
290      {      {
291          $self->SQL("VACUUM ANALYZE");          $ENV{MYSQL_TCP_PORT} = $FIG_Config::dbport;
292            exec $exe, @opts;
293      }      }
294      else      else
295      {      {
296          foreach $table (@tables)          my $pid = fork;
297    
298            if ($pid == 0)
299          {          {
300              $self->SQL("VACUUM ANALYZE $table");              POSIX::setsid();
301    
302                $ENV{MYSQL_TCP_PORT} = $FIG_Config::dbport;
303                exec $exe, @opts;
304          }          }
305            print "Forked db server $pid\n";
306      }      }
307    
308  }  }
309    
310  1  1;

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.27

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3