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

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.23

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3