[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.7, Tue Jan 11 18:59:39 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 =~ /^select/i)
73      {      {
74            my $ok = eval {
75                $tmp = $dbh->selectall_arrayref($sql, undef, @bind_values);
76            };
77            if (!$ok)
78            {
79                confess $@;
80            }
81          return $tmp;          return $tmp;
82      }      }
83      else      else
84      {      {
85          return $dbh->do($sql);          return $dbh->do($sql, undef, @bind_values);
86  #       $sth = $dbh->prepare($sql)  #       $sth = $dbh->prepare($sql)
87  #           or die "prepare failed: $DBI::errstr";  #           or die "prepare failed: $DBI::errstr";
88  #       $sth->execute()  #       $sth->execute()
# Line 60  Line 92 
92      return undef;      return undef;
93  }  }
94    
95    sub get_tables
96    {
97        my($self) = @_;
98    
99        my $dbh = $self->{_dbh};
100    
101        my $quote = $dbh->get_info(29); # SQL_IDENTIFIER_QUOTE_CHAR
102    
103        my @tables = $dbh->tables();
104    
105        return map { $quote ne "" && s/^$quote(.*)$quote$/$1/; s/^[^.]+\.//; $_ } @tables;
106    }
107    
108    sub table_exists
109    {
110        my($self, $table) = @_;
111    
112        return (grep { $table eq $_ } $self->get_tables()) > 0;
113    }
114    
115  sub drop_table {  sub drop_table {
116      my $self = shift @_;      my $self = shift @_;
117      my %arg  = @_;      my %arg  = @_;
# Line 67  Line 119 
119      my $dbh  = $self->{_dbh};      my $dbh  = $self->{_dbh};
120      my $dbms = $self->{_dbms};      my $dbms = $self->{_dbms};
121      my $cmd;      my $cmd;
122      if ($dbms eq "mysql")  { $cmd = "DROP TABLE IF EXISTS $tbl;" ; }  
123      else                   { $cmd = "DROP TABLE $tbl;" ; }  
124        if ($dbms eq "mysql")
125        {
126            $cmd = "DROP TABLE IF EXISTS $tbl;" ;
127        }
128        else
129        {
130            if ($self->table_exists($tbl))
131            {
132                $cmd = "DROP TABLE $tbl;" ;
133            }
134        }
135        if ($cmd)
136        {
137      $dbh->do($cmd);      $dbh->do($cmd);
138  }  }
139    }
140    
141  sub create_table {  sub create_table {
142      my $self = shift @_;      my $self = shift @_;
# Line 158  Line 224 
224      }      }
225  }  }
226    
227    #
228    # Following are database administration routines. They create an instance of a ServerAdmin class
229    # for the appropriate server type (in order to eliminate the if mysql / if pg / etc stuff).
230    #
231    
232    sub get_server_admin
233    {
234        if ($FIG_Config::dbms eq "mysql")
235        {
236            return MysqlAdmin->new();
237        }
238        elsif ($FIG_Config::dbms eq "Pg")
239        {
240            return new PostgresAdmin();
241        }
242        else
243        {
244            warn "Unknown server type $FIG_Config::dbms\n";
245            return undef;
246        }
247    }
248    package MysqlAdmin;
249    
250    use POSIX;
251    use DBI;
252    
253    sub new
254    {
255        my($class) = @_;
256    
257        my $self = {};
258    
259        return bless($self, $class);
260    }
261    
262    sub init_db
263    {
264        my($self, $db_dir) = @_;
265    
266        if (!$db_dir)
267        {
268            warn "init_db failed: db_dir must be provided\n";
269            return;
270        }
271    
272        if (-d "$db_dir/mysql")
273        {
274            warn "init_db: mysql data directory already exists\n";
275            return;
276        }
277    
278        my $exe = "$FIG_Config::ext_bin/mysql_install_db";
279        if (! -x $exe)
280        {
281            $exe = "mysql_install_db";
282        }
283    
284        my $rc = system($exe,
285                        "--datadir=$db_dir",
286                        "--user=$FIG_Config::dbuser");
287        if ($rc != 0)
288        {
289            my $err = $?;
290            if (WIFEXITED($err))
291            {
292                my $exitstat = WEXITSTATUS($err);
293                warn "init_db failed: $exe returned result code $exitstat\n";
294            }
295            else
296            {
297                warn "init_db failed: $exe died with signal ", WTERMSIG($err), "\n";
298            }
299            return;
300        }
301    
302        return 1;
303    }
304    
305    sub create_database
306    {
307        my($self, $db_name) = @_;
308    
309        my $drh = DBI->install_driver("mysql");
310    
311        my @dbs = DBI->data_sources("mysql", { host => $FIG_Config::dbhost,
312                                                   user => $FIG_Config::dbuser,
313                                                   password => $FIG_Config::dbpass });
314        if (grep { $_ eq $db_name } @dbs)
315        {
316            warn "Database $db_name already exists\n";
317            return;
318        }
319    
320        my $rc = $drh->func('createdb', $db_name, $FIG_Config::dbhost,
321                            $FIG_Config::dbuser, $FIG_Config::dbpass, 'admin');
322    
323    
324        if (!$rc)
325        {
326            warn "create_database: createdb call failed: $DBI::errstr\n";
327            return;
328        }
329    
330        return 1;
331    }
332    
333    sub start_server
334    {
335        my($self) = @_;
336    
337        print "Starting mysql server\n";
338    
339        my(@opts);
340    
341        push(@opts, "--port=$FIG_Config::dbport");
342        #
343        # Don't do this; dbuser isn't the unix uid that we are using.
344        #
345        #push(@opts, "--user=$FIG_Config::dbuser");
346        push(@opts, "--basedir=$FIG_Config::common_runtime");
347        push(@opts, "--datadir=$FIG_Config::db_datadir");
348        push(@opts, "--ledir=$FIG_Config::common_runtime/libexec");
349        push(@opts, "--old-password");
350        push(@opts, "--max-allowed-packet=128M");
351        #
352        # Oddly, this doesn't seem to work. need to set the environment variable.
353        #
354        #push(@opts, "--port=$FIG_Config::dbport");
355    
356        #
357        # We are going to assume that if mysql has shipped with this release, we'll use it. Otherwise
358        # try to use a system one.
359        #
360    
361        my $exe = "$FIG_Config::ext_bin/mysqld_safe";
362        if (! -x $exe)
363        {
364            $exe = "mysqld_safe";
365        }
366    
367        my $pid = fork;
368    
369        if ($pid == 0)
370        {
371            POSIX::setsid();
372    
373            $ENV{MYSQL_TCP_PORT} = $FIG_Config::dbport;
374            exec $exe, @opts;
375        }
376    
377        print "Forked db server $pid\n";
378    }
379    
380    
381  1  1

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3