[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.21, Wed Jul 27 17:56:13 2005 UTC
# Line 1  Line 1 
1  package DBrtns;  package DBrtns;
2    
3        # Inherit the DBKernel methods. We must do this BEFORE the "use strict".
4        use DBKernel;
5        @ISA = qw(DBKernel);
6    
7  use strict;  use strict;
8    use POSIX;
9  use DBI;  use DBI;
10  use FIG_Config;  use FIG_Config;
11    
# Line 8  Line 13 
13  use Carp;  use Carp;
14    
15  sub new {  sub new {
16      my($class,$dbms,$dbname,$dbuser,$dbpass,$dbport) = @_;      my($class,$dbms,$dbname,$dbuser,$dbpass,$dbport, $dbhost) = @_;
17    
18      $dbms   = defined($dbms)   ? $dbms   : $FIG_Config::dbms;      $dbms   = defined($dbms)   ? $dbms   : $FIG_Config::dbms;
19      $dbname = defined($dbname) ? $dbname : $FIG_Config::db;      $dbname = defined($dbname) ? $dbname : $FIG_Config::db;
20      $dbuser = defined($dbuser) ? $dbuser : $FIG_Config::dbuser;      $dbuser = defined($dbuser) ? $dbuser : $FIG_Config::dbuser;
21      $dbpass = defined($dbpass) ? $dbpass : $FIG_Config::dbpass;      $dbpass = defined($dbpass) ? $dbpass : $FIG_Config::dbpass;
     $dbpass = defined($dbpass) ? $dbpass : $FIG_Config::dbpass;  
22      $dbport = defined($dbport) ? $dbport : $FIG_Config::dbport;      $dbport = defined($dbport) ? $dbport : $FIG_Config::dbport;
23        $dbhost = defined($dbhost) ? $dbhost : $FIG_Config::dbhost;
24    
25      my @opts;      return DBKernel::new($class, $dbms, $dbname, $dbuser, $dbpass, $dbport, $dbhost);
26    }
     push(@opts, "port=${dbport}");  
27    
28      #  =head1 get_inserted_id
     # Late-model mysql needs to have the client enable loading from local files.  
     #  
29    
30      if ($dbms eq "mysql")  Return the last ID of a row inserted into an autonumber/serial-containing table.
     {  
         push(@opts, "mysql_local_infile=1");  
     }  
31    
32      my $opts = join(";", @opts);  =cut
     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));  
     }  
33    
34      bless {  sub get_inserted_id {
35          _dbh => $dbh,      my($self, $table, $sth) = @_;
36          _dbms => $dbms,      if ($self->{_dbms} eq "Pg") {
37          }, $class;          my $oid = $sth->{pg_oid_status};
38            my $ret = $self->SQL("select id from $table where oid = ?", undef, $oid);
39            return $ret->[0]->[0];
40        } elsif ($self->{_dbms} eq "mysql") {
41            my $id = $self->{_dbh}->{mysql_insertid};
42            # print "mysql got $id\n";
43            return $id;
44  }  }
   
 sub set_raise_exceptions  
 {  
     my($self, $enable) = @_;  
     my $dbh = $self->{_dbh};  
     my $old = $dbh->{RaiseError};  
     $dbh->{RaiseError} = $enable;  
     return $old;  
45  }  }
46    
47  sub SQL {  #
48      my($self,$sql,$verbose) = @_;  # Following are database administration routines. They create an instance of a ServerAdmin class
49      my($dbh,$sth,$rc,$tmp);  # for the appropriate server type (in order to eliminate the if mysql / if pg / etc stuff).
50    #
51    
52      if ($verbose)  sub get_server_admin
53      {      {
54          print STDERR "running: $sql\n";      if ($FIG_Config::dbms eq "mysql")
55        {
56            return MysqlAdmin->new();
57      }      }
58        elsif ($FIG_Config::dbms eq "Pg")
     $dbh  = $self->{_dbh};  
   
     if ($sql =~ /^select/i)  
59      {      {
60          $tmp = $dbh->selectall_arrayref($sql);          return new PostgresAdmin();
         return $tmp;  
61      }      }
62      else      else
63      {      {
64          return $dbh->do($sql);          warn "Unknown server type $FIG_Config::dbms\n";
 #       $sth = $dbh->prepare($sql)  
 #           or die "prepare failed: $DBI::errstr";  
 #       $sth->execute()  
 #           or warn "execute failed: $DBI::errstr";  
 #       return 1;  
     }  
65      return undef;      return undef;
66  }  }
67    }
68    package MysqlAdmin;
69    
70  sub get_tables  use POSIX;
71  {  use DBI;
     my($self) = @_;  
   
     my $dbh = $self->{_dbh};  
72    
73      my $quote = $dbh->get_info(29); # SQL_IDENTIFIER_QUOTE_CHAR  sub new
74    {
75        my($class) = @_;
76    
77      my @tables = $dbh->tables();      my $self = {};
78    
79      return map { $quote ne "" && s/^$quote(.*)$quote$/$1/; s/^[^.]+\.//; $_ } @tables;      return bless($self, $class);
80  }  }
81    
82  sub table_exists  sub init_db
83  {  {
84      my($self, $table) = @_;      my($self, $db_dir) = @_;
85    
86      return (grep { $table eq $_ } $self->get_tables()) > 0;      if (!$db_dir)
87        {
88            warn "init_db failed: db_dir must be provided\n";
89            return;
90  }  }
91    
92  sub drop_table {      if (-d "$db_dir/mysql")
93      my $self = shift @_;      {
94      my %arg  = @_;          warn "init_db: mysql data directory already exists\n";
95      my $tbl  = $arg{tbl};          return;
96      my $dbh  = $self->{_dbh};      }
     my $dbms = $self->{_dbms};  
     my $cmd;  
   
97    
98      if ($dbms eq "mysql")      my $exe = "$FIG_Config::ext_bin/mysql_install_db";
99        if (! -x $exe)
100      {      {
101          $cmd = "DROP TABLE IF EXISTS $tbl;" ;          $exe = "mysql_install_db";
102      }      }
103      else  
104        my $rc = system($exe,
105                        "--datadir=$db_dir",
106                        "--basedir=$FIG_Config::common_runtime",
107                        "--user=$FIG_Config::dbuser");
108        if ($rc != 0)
109      {      {
110          if ($self->table_exists($tbl))          my $err = $?;
111            if (WIFEXITED($err))
112          {          {
113              $cmd = "DROP TABLE $tbl;" ;              my $exitstat = WEXITSTATUS($err);
114          }              warn "init_db failed: $exe returned result code $exitstat\n";
115      }      }
116      if ($cmd)          else
117      {      {
118          $dbh->do($cmd);              warn "init_db failed: $exe died with signal ", WTERMSIG($err), "\n";
119      }      }
120            return;
121  }  }
122    
123  sub create_table {      return 1;
     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 );");  
124  }  }
125    
126  sub load_table {  sub create_database
     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)  
127      {      {
128          if ($dbms eq "mysql")      my($self, $db_name) = @_;
129    
130        my $drh = DBI->install_driver("mysql");
131    
132        my @dbs = DBI->data_sources("mysql", { host => $FIG_Config::dbhost,
133                                                   user => $FIG_Config::dbuser,
134                                                   password => $FIG_Config::dbpass });
135        if (grep { $_ eq $db_name } @dbs)
136          {          {
137              $dbh->do("LOAD DATA LOCAL INFILE '$file' REPLACE INTO TABLE $tbl;");          warn "Database $db_name already exists\n";
138            return;
139          }          }
140          elsif ($dbms eq "Pg")  
141        my $rc = $drh->func('createdb', $db_name, $FIG_Config::dbhost,
142                            $FIG_Config::dbuser, $FIG_Config::dbpass, 'admin');
143    
144    
145        if (!$rc)
146          {          {
147              $dbh->do("COPY $tbl FROM '$file' USING DELIMITERS '$delim';");          warn "create_database: createdb call failed: $DBI::errstr\n";
148          }          return;
149      }      }
150    
151        return 1;
152  }  }
153    
154  sub create_index {  sub start_server
     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")  
155      {      {
156          $cmd .= " USING $type ";      my($self, $dont_fork) = @_;
157      }  
158      $cmd .= " ( $flds );";      print "Starting mysql server\n";
159      $dbh->do($cmd);  
160  }      my(@opts);
161    
162  sub DESTROY {      push(@opts, "--port=$FIG_Config::dbport");
163      my($self) = @_;      #
164        # Don't do this; dbuser isn't the unix uid that we are using.
165        #
166        #push(@opts, "--user=$FIG_Config::dbuser");
167        push(@opts, "--basedir=$FIG_Config::common_runtime");
168        push(@opts, "--datadir=$FIG_Config::db_datadir");
169        push(@opts, "--ledir=$FIG_Config::common_runtime/libexec");
170        push(@opts, "--old-password");
171        push(@opts, "--max-allowed-packet=128M");
172        #
173        # Use InnoDB for large-table support and allegedly better performance.
174        #
175    
176        push(@opts, "--default-table-type=innodb");
177    
178        #
179        # Oddly, this doesn't seem to work. need to set the environment variable.
180        #
181        #push(@opts, "--port=$FIG_Config::dbport");
182    
183      my($dbh);      if (@FIG_Config::db_server_startup_options)
     if ($dbh = $self->{_dbh})  
184      {      {
185          $dbh->disconnect;          push(@opts, @FIG_Config::db_server_startup_options)
     }  
186  }  }
187    
188  sub vacuum_it {      #
189      my($self,@tables) = @_;      # We are going to assume that if mysql has shipped with this release, we'll use it. Otherwise
190      my($table);      # try to use a system one.
191        #
192    
193        my $exe = "$FIG_Config::ext_bin/mysqld_safe";
194    
195      my $dbh  = $self->{_dbh};      print "Start $exe @opts\n";
196      my $dbms = $self->{_dbms};      if (! -x $exe)
     if ($dbms eq "mysql")  
197      {      {
198          return;          $exe = "mysqld_safe";
199      }      }
200    
201      # this chunk is for Pg  (Postgres)      if ($dont_fork)
     if (@tables == 0)  
202      {      {
203          $self->SQL("VACUUM ANALYZE");          $ENV{MYSQL_TCP_PORT} = $FIG_Config::dbport;
204            exec $exe, @opts;
205      }      }
206      else      else
207      {      {
208          foreach $table (@tables)          my $pid = fork;
209    
210            if ($pid == 0)
211          {          {
212              $self->SQL("VACUUM ANALYZE $table");              POSIX::setsid();
213    
214                $ENV{MYSQL_TCP_PORT} = $FIG_Config::dbport;
215                exec $exe, @opts;
216          }          }
217            print "Forked db server $pid\n";
218      }      }
219    
220  }  }
221    
222  1  1;

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3