[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.17, Wed Jun 1 01:18:50 2005 UTC
# Line 1  Line 1 
1  package DBrtns;  package DBrtns;
2    
3  use strict;  use strict;
4    use POSIX;
5  use DBI;  use DBI;
6  use FIG_Config;  use FIG_Config;
7    
# Line 14  Line 15 
15      $dbname = defined($dbname) ? $dbname : $FIG_Config::db;      $dbname = defined($dbname) ? $dbname : $FIG_Config::db;
16      $dbuser = defined($dbuser) ? $dbuser : $FIG_Config::dbuser;      $dbuser = defined($dbuser) ? $dbuser : $FIG_Config::dbuser;
17      $dbpass = defined($dbpass) ? $dbpass : $FIG_Config::dbpass;      $dbpass = defined($dbpass) ? $dbpass : $FIG_Config::dbpass;
     $dbpass = defined($dbpass) ? $dbpass : $FIG_Config::dbpass;  
18      $dbport = defined($dbport) ? $dbport : $FIG_Config::dbport;      $dbport = defined($dbport) ? $dbport : $FIG_Config::dbport;
19    
20      my @opts;      my @opts;
# Line 58  Line 58 
58  }  }
59    
60  sub SQL {  sub SQL {
61      my($self,$sql,$verbose) = @_;      my($self, $sql, $verbose, @bind_values) = @_;
62      my($dbh,$sth,$rc,$tmp);      my($dbh,$sth,$rc,$tmp);
63    
64      if ($verbose)      if ($verbose)
# Line 68  Line 68 
68    
69      $dbh  = $self->{_dbh};      $dbh  = $self->{_dbh};
70    
71      if ($sql =~ /^select/i)      if ($sql =~ /^\s*select/i)
72      {      {
73          $tmp = $dbh->selectall_arrayref($sql);          eval {
74                $tmp = $dbh->selectall_arrayref($sql, undef, @bind_values);
75            };
76            if (!$tmp or $@)
77            {
78                confess "Try running 'load_links' and 'load_attributes' to fix this error:\n$@";
79                #print STDERR "DBrtns.pm error: SQL $sql failed\n";
80                #return;
81            }
82          return $tmp;          return $tmp;
83      }      }
84      else      else
85      {      {
86          return $dbh->do($sql);          my $rc;
87            my $ok = eval {
88                $rc = $dbh->do($sql, undef, @bind_values);
89            };
90    
91            if (!$ok)
92            {
93                confess "query failed: " . substr($sql, 0, 100) . ": $@";
94            }
95            return $rc;
96    
97    
98  #       $sth = $dbh->prepare($sql)  #       $sth = $dbh->prepare($sql)
99  #           or die "prepare failed: $DBI::errstr";  #           or die "prepare failed: $DBI::errstr";
100  #       $sth->execute()  #       $sth->execute()
# Line 102  Line 121 
121  {  {
122      my($self, $table) = @_;      my($self, $table) = @_;
123    
124      return (grep { $table eq $_ } $self->get_tables()) > 0;      return (grep { lc $table eq lc $_ } $self->get_tables()) > 0;
125  }  }
126    
127  sub drop_table {  sub drop_table {
# Line 118  Line 137 
137      {      {
138          $cmd = "DROP TABLE IF EXISTS $tbl;" ;          $cmd = "DROP TABLE IF EXISTS $tbl;" ;
139      }      }
140        elsif ($dbms eq "Pg")
141        {
142            if ($self->table_exists($tbl))
143            {
144                $cmd = "DROP TABLE $tbl CASCADE;" ;
145            }
146        }
147      else      else
148      {      {
149          if ($self->table_exists($tbl))          if ($self->table_exists($tbl))
# Line 138  Line 164 
164      my $flds = $arg{flds};      my $flds = $arg{flds};
165      my $dbh  = $self->{_dbh};      my $dbh  = $self->{_dbh};
166      my $dbms = $self->{_dbms};      my $dbms = $self->{_dbms};
167      $dbh->do("CREATE TABLE $tbl ( $flds );");      my $type;
168    
169        if ($arg{type})
170        {
171            $type = " engine = $arg{type} ";
172        }
173    
174        eval {
175            $dbh->do("CREATE TABLE $tbl ( $flds ) $type;");
176        };
177        if ($@)
178        {
179            confess "create table $tbl failed: $@";
180        }
181  }  }
182    
183  sub load_table {  sub load_table {
# Line 150  Line 189 
189      my $delim    = $arg{delim};      my $delim    = $arg{delim};
190      my $dbh  = $self->{_dbh};      my $dbh  = $self->{_dbh};
191      my $dbms = $self->{_dbms};      my $dbms = $self->{_dbms};
192        my $result;
193    
194      if ($file)      if ($file)
195      {      {
196          if ($dbms eq "mysql")          if ($dbms eq "mysql")
197          {          {
198              $dbh->do("LOAD DATA LOCAL INFILE '$file' REPLACE INTO TABLE $tbl;");              $result = $dbh->do("LOAD DATA LOCAL INFILE '$file' REPLACE INTO TABLE $tbl;");
199          }          }
200          elsif ($dbms eq "Pg")          elsif ($dbms eq "Pg")
201          {          {
202              $dbh->do("COPY $tbl FROM '$file' USING DELIMITERS '$delim';");              $result = $dbh->do("COPY $tbl FROM '$file' USING DELIMITERS '$delim';");
203          }          }
204      }      }
205        return $result;
206  }  }
207    
208  sub create_index {  sub create_index {
# Line 217  Line 258 
258      }      }
259  }  }
260    
261    =pod
262    
263    =head1 get_inserted_id
264    
265    Return the last ID of a row inserted into an autonumber/serial-containing table.
266    
267    =cut
268    
269    sub get_inserted_id
270    {
271        my($self, $table, $sth) = @_;
272        if ($self->{_dbms} eq "Pg")
273        {
274            my $oid = $sth->{pg_oid_status};
275            my $ret = $self->SQL("select id from $table where oid = ?", undef, $oid);
276            return $ret->[0]->[0];
277        }
278        elsif ($self->{_dbms} eq "mysql")
279        {
280            my $id = $self->{_dbh}->{mysql_insertid};
281            # print "mysql got $id\n";
282            return $id;
283        }
284    }
285    
286    #
287    # Following are database administration routines. They create an instance of a ServerAdmin class
288    # for the appropriate server type (in order to eliminate the if mysql / if pg / etc stuff).
289    #
290    
291    sub get_server_admin
292    {
293        if ($FIG_Config::dbms eq "mysql")
294        {
295            return MysqlAdmin->new();
296        }
297        elsif ($FIG_Config::dbms eq "Pg")
298        {
299            return new PostgresAdmin();
300        }
301        else
302        {
303            warn "Unknown server type $FIG_Config::dbms\n";
304            return undef;
305        }
306    }
307    package MysqlAdmin;
308    
309    use POSIX;
310    use DBI;
311    
312    sub new
313    {
314        my($class) = @_;
315    
316        my $self = {};
317    
318        return bless($self, $class);
319    }
320    
321    sub init_db
322    {
323        my($self, $db_dir) = @_;
324    
325        if (!$db_dir)
326        {
327            warn "init_db failed: db_dir must be provided\n";
328            return;
329        }
330    
331        if (-d "$db_dir/mysql")
332        {
333            warn "init_db: mysql data directory already exists\n";
334            return;
335        }
336    
337        my $exe = "$FIG_Config::ext_bin/mysql_install_db";
338        if (! -x $exe)
339        {
340            $exe = "mysql_install_db";
341        }
342    
343        my $rc = system($exe,
344                        "--datadir=$db_dir",
345                        "--basedir=$FIG_Config::common_runtime",
346                        "--user=$FIG_Config::dbuser");
347        if ($rc != 0)
348        {
349            my $err = $?;
350            if (WIFEXITED($err))
351            {
352                my $exitstat = WEXITSTATUS($err);
353                warn "init_db failed: $exe returned result code $exitstat\n";
354            }
355            else
356            {
357                warn "init_db failed: $exe died with signal ", WTERMSIG($err), "\n";
358            }
359            return;
360        }
361    
362        return 1;
363    }
364    
365    sub create_database
366    {
367        my($self, $db_name) = @_;
368    
369        my $drh = DBI->install_driver("mysql");
370    
371        my @dbs = DBI->data_sources("mysql", { host => $FIG_Config::dbhost,
372                                                   user => $FIG_Config::dbuser,
373                                                   password => $FIG_Config::dbpass });
374        if (grep { $_ eq $db_name } @dbs)
375        {
376            warn "Database $db_name already exists\n";
377            return;
378        }
379    
380        my $rc = $drh->func('createdb', $db_name, $FIG_Config::dbhost,
381                            $FIG_Config::dbuser, $FIG_Config::dbpass, 'admin');
382    
383    
384        if (!$rc)
385        {
386            warn "create_database: createdb call failed: $DBI::errstr\n";
387            return;
388        }
389    
390        return 1;
391    }
392    
393    sub start_server
394    {
395        my($self, $dont_fork) = @_;
396    
397        print "Starting mysql server\n";
398    
399        my(@opts);
400    
401        push(@opts, "--port=$FIG_Config::dbport");
402        #
403        # Don't do this; dbuser isn't the unix uid that we are using.
404        #
405        #push(@opts, "--user=$FIG_Config::dbuser");
406        push(@opts, "--basedir=$FIG_Config::common_runtime");
407        push(@opts, "--datadir=$FIG_Config::db_datadir");
408        push(@opts, "--ledir=$FIG_Config::common_runtime/libexec");
409        push(@opts, "--old-password");
410        push(@opts, "--max-allowed-packet=128M");
411        #
412        # Oddly, this doesn't seem to work. need to set the environment variable.
413        #
414        #push(@opts, "--port=$FIG_Config::dbport");
415    
416        if (@FIG_Config::db_server_startup_options)
417        {
418            push(@opts, @FIG_Config::db_server_startup_options)
419        }
420    
421        #
422        # We are going to assume that if mysql has shipped with this release, we'll use it. Otherwise
423        # try to use a system one.
424        #
425    
426        my $exe = "$FIG_Config::ext_bin/mysqld_safe";
427        if (! -x $exe)
428        {
429            $exe = "mysqld_safe";
430        }
431    
432        if ($dont_fork)
433        {
434            $ENV{MYSQL_TCP_PORT} = $FIG_Config::dbport;
435            exec $exe, @opts;
436        }
437        else
438        {
439            my $pid = fork;
440    
441            if ($pid == 0)
442            {
443                POSIX::setsid();
444    
445                $ENV{MYSQL_TCP_PORT} = $FIG_Config::dbport;
446                exec $exe, @opts;
447            }
448            print "Forked db server $pid\n";
449        }
450    
451    }
452    
453    
454  1  1

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3