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

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.15

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3