[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.12, Fri Apr 8 08:32:10 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    
8  use Data::Dumper;  use Data::Dumper;
9  use Carp  use Carp;
10  ;sub new {  
11    sub new {
12      my($class,$dbms,$dbname,$dbuser,$dbpass,$dbport) = @_;      my($class,$dbms,$dbname,$dbuser,$dbpass,$dbport) = @_;
13    
14      $dbms   = defined($dbms)   ? $dbms   : $FIG_Config::dbms;      $dbms   = defined($dbms)   ? $dbms   : $FIG_Config::dbms;
# Line 16  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 33  Line 49 
49          }, $class;          }, $class;
50  }  }
51    
52    sub set_raise_exceptions
53    {
54        my($self, $enable) = @_;
55        my $dbh = $self->{_dbh};
56        my $old = $dbh->{RaiseError};
57        $dbh->{RaiseError} = $enable;
58        return $old;
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 44  Line 69 
69    
70      $dbh  = $self->{_dbh};      $dbh  = $self->{_dbh};
71    
72      if (($sql =~ /^select/i) && ($tmp = $dbh->selectall_arrayref($sql)))      if ($sql =~ /^\s*select/i)
73      {      {
74            my $ok = eval {
75                $tmp = $dbh->selectall_arrayref($sql, undef, @bind_values);
76            };
77            if (!$ok)
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 60  Line 105 
105      return undef;      return undef;
106  }  }
107    
108    sub get_tables
109    {
110        my($self) = @_;
111    
112        my $dbh = $self->{_dbh};
113    
114        my $quote = $dbh->get_info(29); # SQL_IDENTIFIER_QUOTE_CHAR
115    
116        my @tables = $dbh->tables();
117    
118        return map { $quote ne "" && s/^$quote(.*)$quote$/$1/; s/^[^.]+\.//; $_ } @tables;
119    }
120    
121    sub table_exists
122    {
123        my($self, $table) = @_;
124    
125        return (grep { $table eq $_ } $self->get_tables()) > 0;
126    }
127    
128  sub drop_table {  sub drop_table {
129      my $self = shift @_;      my $self = shift @_;
130      my %arg  = @_;      my %arg  = @_;
# Line 67  Line 132 
132      my $dbh  = $self->{_dbh};      my $dbh  = $self->{_dbh};
133      my $dbms = $self->{_dbms};      my $dbms = $self->{_dbms};
134      my $cmd;      my $cmd;
135      if ($dbms eq "mysql")  { $cmd = "DROP TABLE IF EXISTS $tbl;" ; }  
136      else                   { $cmd = "DROP TABLE $tbl;" ; }  
137        if ($dbms eq "mysql")
138        {
139            $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
149        {
150            if ($self->table_exists($tbl))
151            {
152                $cmd = "DROP TABLE $tbl;" ;
153            }
154        }
155        if ($cmd)
156        {
157      $dbh->do($cmd);      $dbh->do($cmd);
158  }  }
159    }
160    
161  sub create_table {  sub create_table {
162      my $self = shift @_;      my $self = shift @_;
# Line 158  Line 244 
244      }      }
245  }  }
246    
247    =pod
248    
249    =head1 get_inserted_id
250    
251    Return the last ID of a row inserted into an autonumber/serial-containing table.
252    
253    =cut
254    
255    sub get_inserted_id
256    {
257        my($self, $table, $sth) = @_;
258        if ($self->{_dbms} eq "Pg")
259        {
260            my $oid = $sth->{pg_oid_status};
261            my $ret = $self->SQL("select id from $table where oid = ?", undef, $oid);
262            return $ret->[0]->[0];
263        }
264        elsif ($self->{_dbms} eq "mysql")
265        {
266            my $id = $self->{_dbh}->{mysql_insertid};
267            # print "mysql got $id\n";
268            return $id;
269        }
270    }
271    
272    
273    #
274    # Following are database administration routines. They create an instance of a ServerAdmin class
275    # for the appropriate server type (in order to eliminate the if mysql / if pg / etc stuff).
276    #
277    
278    sub get_server_admin
279    {
280        if ($FIG_Config::dbms eq "mysql")
281        {
282            return MysqlAdmin->new();
283        }
284        elsif ($FIG_Config::dbms eq "Pg")
285        {
286            return new PostgresAdmin();
287        }
288        else
289        {
290            warn "Unknown server type $FIG_Config::dbms\n";
291            return undef;
292        }
293    }
294    package MysqlAdmin;
295    
296    use POSIX;
297    use DBI;
298    
299    sub new
300    {
301        my($class) = @_;
302    
303        my $self = {};
304    
305        return bless($self, $class);
306    }
307    
308    sub init_db
309    {
310        my($self, $db_dir) = @_;
311    
312        if (!$db_dir)
313        {
314            warn "init_db failed: db_dir must be provided\n";
315            return;
316        }
317    
318        if (-d "$db_dir/mysql")
319        {
320            warn "init_db: mysql data directory already exists\n";
321            return;
322        }
323    
324        my $exe = "$FIG_Config::ext_bin/mysql_install_db";
325        if (! -x $exe)
326        {
327            $exe = "mysql_install_db";
328        }
329    
330        my $rc = system($exe,
331                        "--datadir=$db_dir",
332                        "--user=$FIG_Config::dbuser");
333        if ($rc != 0)
334        {
335            my $err = $?;
336            if (WIFEXITED($err))
337            {
338                my $exitstat = WEXITSTATUS($err);
339                warn "init_db failed: $exe returned result code $exitstat\n";
340            }
341            else
342            {
343                warn "init_db failed: $exe died with signal ", WTERMSIG($err), "\n";
344            }
345            return;
346        }
347    
348        return 1;
349    }
350    
351    sub create_database
352    {
353        my($self, $db_name) = @_;
354    
355        my $drh = DBI->install_driver("mysql");
356    
357        my @dbs = DBI->data_sources("mysql", { host => $FIG_Config::dbhost,
358                                                   user => $FIG_Config::dbuser,
359                                                   password => $FIG_Config::dbpass });
360        if (grep { $_ eq $db_name } @dbs)
361        {
362            warn "Database $db_name already exists\n";
363            return;
364        }
365    
366        my $rc = $drh->func('createdb', $db_name, $FIG_Config::dbhost,
367                            $FIG_Config::dbuser, $FIG_Config::dbpass, 'admin');
368    
369    
370        if (!$rc)
371        {
372            warn "create_database: createdb call failed: $DBI::errstr\n";
373            return;
374        }
375    
376        return 1;
377    }
378    
379    sub start_server
380    {
381        my($self) = @_;
382    
383        print "Starting mysql server\n";
384    
385        my(@opts);
386    
387        push(@opts, "--port=$FIG_Config::dbport");
388        #
389        # Don't do this; dbuser isn't the unix uid that we are using.
390        #
391        #push(@opts, "--user=$FIG_Config::dbuser");
392        push(@opts, "--basedir=$FIG_Config::common_runtime");
393        push(@opts, "--datadir=$FIG_Config::db_datadir");
394        push(@opts, "--ledir=$FIG_Config::common_runtime/libexec");
395        push(@opts, "--old-password");
396        push(@opts, "--max-allowed-packet=128M");
397        #
398        # Oddly, this doesn't seem to work. need to set the environment variable.
399        #
400        #push(@opts, "--port=$FIG_Config::dbport");
401    
402        #
403        # We are going to assume that if mysql has shipped with this release, we'll use it. Otherwise
404        # try to use a system one.
405        #
406    
407        my $exe = "$FIG_Config::ext_bin/mysqld_safe";
408        if (! -x $exe)
409        {
410            $exe = "mysqld_safe";
411        }
412    
413        my $pid = fork;
414    
415        if ($pid == 0)
416        {
417            POSIX::setsid();
418    
419            $ENV{MYSQL_TCP_PORT} = $FIG_Config::dbport;
420            exec $exe, @opts;
421        }
422    
423        print "Forked db server $pid\n";
424    }
425    
426    
427  1  1

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3