[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.9, Sat Feb 26 23:32:45 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 "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        else
142        {
143            if ($self->table_exists($tbl))
144            {
145                $cmd = "DROP TABLE $tbl;" ;
146            }
147        }
148        if ($cmd)
149        {
150      $dbh->do($cmd);      $dbh->do($cmd);
151  }  }
152    }
153    
154  sub create_table {  sub create_table {
155      my $self = shift @_;      my $self = shift @_;
# Line 158  Line 237 
237      }      }
238  }  }
239    
240    #
241    # Following are database administration routines. They create an instance of a ServerAdmin class
242    # for the appropriate server type (in order to eliminate the if mysql / if pg / etc stuff).
243    #
244    
245    sub get_server_admin
246    {
247        if ($FIG_Config::dbms eq "mysql")
248        {
249            return MysqlAdmin->new();
250        }
251        elsif ($FIG_Config::dbms eq "Pg")
252        {
253            return new PostgresAdmin();
254        }
255        else
256        {
257            warn "Unknown server type $FIG_Config::dbms\n";
258            return undef;
259        }
260    }
261    package MysqlAdmin;
262    
263    use POSIX;
264    use DBI;
265    
266    sub new
267    {
268        my($class) = @_;
269    
270        my $self = {};
271    
272        return bless($self, $class);
273    }
274    
275    sub init_db
276    {
277        my($self, $db_dir) = @_;
278    
279        if (!$db_dir)
280        {
281            warn "init_db failed: db_dir must be provided\n";
282            return;
283        }
284    
285        if (-d "$db_dir/mysql")
286        {
287            warn "init_db: mysql data directory already exists\n";
288            return;
289        }
290    
291        my $exe = "$FIG_Config::ext_bin/mysql_install_db";
292        if (! -x $exe)
293        {
294            $exe = "mysql_install_db";
295        }
296    
297        my $rc = system($exe,
298                        "--datadir=$db_dir",
299                        "--user=$FIG_Config::dbuser");
300        if ($rc != 0)
301        {
302            my $err = $?;
303            if (WIFEXITED($err))
304            {
305                my $exitstat = WEXITSTATUS($err);
306                warn "init_db failed: $exe returned result code $exitstat\n";
307            }
308            else
309            {
310                warn "init_db failed: $exe died with signal ", WTERMSIG($err), "\n";
311            }
312            return;
313        }
314    
315        return 1;
316    }
317    
318    sub create_database
319    {
320        my($self, $db_name) = @_;
321    
322        my $drh = DBI->install_driver("mysql");
323    
324        my @dbs = DBI->data_sources("mysql", { host => $FIG_Config::dbhost,
325                                                   user => $FIG_Config::dbuser,
326                                                   password => $FIG_Config::dbpass });
327        if (grep { $_ eq $db_name } @dbs)
328        {
329            warn "Database $db_name already exists\n";
330            return;
331        }
332    
333        my $rc = $drh->func('createdb', $db_name, $FIG_Config::dbhost,
334                            $FIG_Config::dbuser, $FIG_Config::dbpass, 'admin');
335    
336    
337        if (!$rc)
338        {
339            warn "create_database: createdb call failed: $DBI::errstr\n";
340            return;
341        }
342    
343        return 1;
344    }
345    
346    sub start_server
347    {
348        my($self) = @_;
349    
350        print "Starting mysql server\n";
351    
352        my(@opts);
353    
354        push(@opts, "--port=$FIG_Config::dbport");
355        #
356        # Don't do this; dbuser isn't the unix uid that we are using.
357        #
358        #push(@opts, "--user=$FIG_Config::dbuser");
359        push(@opts, "--basedir=$FIG_Config::common_runtime");
360        push(@opts, "--datadir=$FIG_Config::db_datadir");
361        push(@opts, "--ledir=$FIG_Config::common_runtime/libexec");
362        push(@opts, "--old-password");
363        push(@opts, "--max-allowed-packet=128M");
364        #
365        # Oddly, this doesn't seem to work. need to set the environment variable.
366        #
367        #push(@opts, "--port=$FIG_Config::dbport");
368    
369        #
370        # We are going to assume that if mysql has shipped with this release, we'll use it. Otherwise
371        # try to use a system one.
372        #
373    
374        my $exe = "$FIG_Config::ext_bin/mysqld_safe";
375        if (! -x $exe)
376        {
377            $exe = "mysqld_safe";
378        }
379    
380        my $pid = fork;
381    
382        if ($pid == 0)
383        {
384            POSIX::setsid();
385    
386            $ENV{MYSQL_TCP_PORT} = $FIG_Config::dbport;
387            exec $exe, @opts;
388        }
389    
390        print "Forked db server $pid\n";
391    }
392    
393    
394  1  1

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3