[Bio] / FigKernelPackages / DBrtns.pm Repository:
ViewVC logotype

Annotation of /FigKernelPackages/DBrtns.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.16 - (view) (download) (as text)

1 : efrank 1.1 package DBrtns;
2 :    
3 :     use strict;
4 : olson 1.5 use POSIX;
5 : efrank 1.1 use DBI;
6 :     use FIG_Config;
7 :    
8 :     use Data::Dumper;
9 : overbeek 1.2 use Carp;
10 :    
11 :     sub new {
12 : efrank 1.1 my($class,$dbms,$dbname,$dbuser,$dbpass,$dbport) = @_;
13 :    
14 :     $dbms = defined($dbms) ? $dbms : $FIG_Config::dbms;
15 :     $dbname = defined($dbname) ? $dbname : $FIG_Config::db;
16 :     $dbuser = defined($dbuser) ? $dbuser : $FIG_Config::dbuser;
17 :     $dbpass = defined($dbpass) ? $dbpass : $FIG_Config::dbpass;
18 :     $dbport = defined($dbport) ? $dbport : $FIG_Config::dbport;
19 :    
20 : olson 1.4 my @opts;
21 :    
22 :     push(@opts, "port=${dbport}");
23 :    
24 :     #
25 :     # Late-model mysql needs to have the client enable loading from local files.
26 :     #
27 :    
28 :     if ($dbms eq "mysql")
29 :     {
30 :     push(@opts, "mysql_local_infile=1");
31 :     }
32 :    
33 :     my $opts = join(";", @opts);
34 :     my $data_source = "DBI:$dbms(AutoCommit => 1):dbname=$dbname;$opts";
35 : efrank 1.1 my $dbh = DBI->connect( $data_source, $dbuser, $dbpass )
36 :     || die "ERROR: Could not connect to $data_source; ", DBI->errstr, "\n";
37 :     $dbh->{PrintError} = 1;
38 :     $dbh->{RaiseError} = 0;
39 :     if ($dbms eq "Pg")
40 :     {
41 :     $dbh->do(qq(SET "ENABLE_SEQSCAN" TO "OFF"));
42 :     $dbh->do(qq(SET DATESTYLE TO Postgres,US));
43 :     }
44 :    
45 :     bless {
46 :     _dbh => $dbh,
47 :     _dbms => $dbms,
48 :     }, $class;
49 :     }
50 :    
51 : olson 1.3 sub set_raise_exceptions
52 :     {
53 :     my($self, $enable) = @_;
54 :     my $dbh = $self->{_dbh};
55 :     my $old = $dbh->{RaiseError};
56 :     $dbh->{RaiseError} = $enable;
57 :     return $old;
58 :     }
59 :    
60 : efrank 1.1 sub SQL {
61 : olson 1.7 my($self, $sql, $verbose, @bind_values) = @_;
62 : efrank 1.1 my($dbh,$sth,$rc,$tmp);
63 :    
64 :     if ($verbose)
65 :     {
66 :     print STDERR "running: $sql\n";
67 :     }
68 :    
69 :     $dbh = $self->{_dbh};
70 : redwards 1.8
71 : olson 1.12 if ($sql =~ /^\s*select/i)
72 : efrank 1.1 {
73 : disz 1.14 eval {
74 : olson 1.7 $tmp = $dbh->selectall_arrayref($sql, undef, @bind_values);
75 :     };
76 : disz 1.14 if (!$tmp or $@)
77 : olson 1.7 {
78 : redwards 1.8 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 : olson 1.7 }
82 : efrank 1.1 return $tmp;
83 :     }
84 :     else
85 :     {
86 : olson 1.9 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 : efrank 1.1 # $sth = $dbh->prepare($sql)
99 :     # or die "prepare failed: $DBI::errstr";
100 :     # $sth->execute()
101 :     # or warn "execute failed: $DBI::errstr";
102 :     # return 1;
103 :     }
104 :     return undef;
105 :     }
106 :    
107 : olson 1.3 sub get_tables
108 :     {
109 :     my($self) = @_;
110 :    
111 :     my $dbh = $self->{_dbh};
112 :    
113 :     my $quote = $dbh->get_info(29); # SQL_IDENTIFIER_QUOTE_CHAR
114 :    
115 :     my @tables = $dbh->tables();
116 :    
117 :     return map { $quote ne "" && s/^$quote(.*)$quote$/$1/; s/^[^.]+\.//; $_ } @tables;
118 :     }
119 :    
120 :     sub table_exists
121 :     {
122 :     my($self, $table) = @_;
123 :    
124 :     return (grep { $table eq $_ } $self->get_tables()) > 0;
125 :     }
126 :    
127 : efrank 1.1 sub drop_table {
128 :     my $self = shift @_;
129 :     my %arg = @_;
130 :     my $tbl = $arg{tbl};
131 :     my $dbh = $self->{_dbh};
132 :     my $dbms = $self->{_dbms};
133 :     my $cmd;
134 : olson 1.3
135 :    
136 :     if ($dbms eq "mysql")
137 :     {
138 :     $cmd = "DROP TABLE IF EXISTS $tbl;" ;
139 :     }
140 : olson 1.10 elsif ($dbms eq "Pg")
141 :     {
142 :     if ($self->table_exists($tbl))
143 :     {
144 :     $cmd = "DROP TABLE $tbl CASCADE;" ;
145 :     }
146 :     }
147 : olson 1.3 else
148 :     {
149 :     if ($self->table_exists($tbl))
150 :     {
151 :     $cmd = "DROP TABLE $tbl;" ;
152 :     }
153 :     }
154 :     if ($cmd)
155 :     {
156 :     $dbh->do($cmd);
157 :     }
158 : efrank 1.1 }
159 :    
160 :     sub create_table {
161 :     my $self = shift @_;
162 :     my %arg = @_;
163 :     my $tbl = $arg{tbl};
164 :     my $flds = $arg{flds};
165 :     my $dbh = $self->{_dbh};
166 :     my $dbms = $self->{_dbms};
167 : olson 1.15 my $type;
168 :    
169 :     if ($arg{type})
170 :     {
171 :     $type = " engine = $arg{type} ";
172 :     }
173 : olson 1.16
174 :     eval {
175 :     $dbh->do("CREATE TABLE $tbl ( $flds ) $type;");
176 :     };
177 :     if ($@)
178 :     {
179 :     confess "create table $tbl failed: $@";
180 :     }
181 : efrank 1.1 }
182 :    
183 :     sub load_table {
184 :     my $self = shift @_;
185 :     my %defaults = ( delim => "\t" );
186 :     my %arg = (%defaults, @_);
187 :     my $file = $arg{file};
188 :     my $tbl = $arg{tbl};
189 :     my $delim = $arg{delim};
190 :     my $dbh = $self->{_dbh};
191 :     my $dbms = $self->{_dbms};
192 : redwards 1.13 my $result;
193 :    
194 : efrank 1.1 if ($file)
195 :     {
196 :     if ($dbms eq "mysql")
197 :     {
198 : redwards 1.13 $result = $dbh->do("LOAD DATA LOCAL INFILE '$file' REPLACE INTO TABLE $tbl;");
199 : efrank 1.1 }
200 :     elsif ($dbms eq "Pg")
201 :     {
202 : redwards 1.13 $result = $dbh->do("COPY $tbl FROM '$file' USING DELIMITERS '$delim';");
203 : efrank 1.1 }
204 :     }
205 : redwards 1.13 return $result;
206 : efrank 1.1 }
207 :    
208 :     sub create_index {
209 :     my $self = shift @_;
210 :     my %arg = @_;
211 :     my $tbl = $arg{tbl};
212 :     my $idx = $arg{idx};
213 :     my $flds = $arg{flds};
214 :     my $type = $arg{type};
215 :     my $dbh = $self->{_dbh};
216 :     my $dbms = $self->{_dbms};
217 :     my $cmd = "CREATE INDEX $idx ON $tbl ";
218 :     if ($type && $dbms eq "Pg")
219 :     {
220 :     $cmd .= " USING $type ";
221 :     }
222 :     $cmd .= " ( $flds );";
223 :     $dbh->do($cmd);
224 :     }
225 :    
226 :     sub DESTROY {
227 :     my($self) = @_;
228 :    
229 :     my($dbh);
230 :     if ($dbh = $self->{_dbh})
231 :     {
232 :     $dbh->disconnect;
233 :     }
234 :     }
235 :    
236 :     sub vacuum_it {
237 :     my($self,@tables) = @_;
238 :     my($table);
239 :    
240 :     my $dbh = $self->{_dbh};
241 :     my $dbms = $self->{_dbms};
242 :     if ($dbms eq "mysql")
243 :     {
244 :     return;
245 :     }
246 :    
247 :     # this chunk is for Pg (Postgres)
248 :     if (@tables == 0)
249 :     {
250 :     $self->SQL("VACUUM ANALYZE");
251 :     }
252 :     else
253 :     {
254 :     foreach $table (@tables)
255 :     {
256 :     $self->SQL("VACUUM ANALYZE $table");
257 :     }
258 :     }
259 :     }
260 :    
261 : olson 1.11 =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 : olson 1.5 #
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 : olson 1.15 "--basedir=$FIG_Config::common_runtime",
346 : olson 1.5 "--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 : olson 1.16 my($self, $dont_fork) = @_;
396 : olson 1.5
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 : olson 1.6 push(@opts, "--old-password");
410 :     push(@opts, "--max-allowed-packet=128M");
411 : olson 1.5 #
412 :     # Oddly, this doesn't seem to work. need to set the environment variable.
413 :     #
414 :     #push(@opts, "--port=$FIG_Config::dbport");
415 :    
416 : olson 1.15 if (@FIG_Config::db_server_startup_options)
417 :     {
418 :     push(@opts, @FIG_Config::db_server_startup_options)
419 :     }
420 :    
421 : olson 1.5 #
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 : olson 1.16 if ($dont_fork)
433 : olson 1.5 {
434 :     $ENV{MYSQL_TCP_PORT} = $FIG_Config::dbport;
435 :     exec $exe, @opts;
436 :     }
437 : olson 1.16 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 : olson 1.5
451 :     }
452 :    
453 :    
454 : efrank 1.1 1

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3