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

Annotation of /FigKernelPackages/DBrtns.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.15 - (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 :     $dbpass = defined($dbpass) ? $dbpass : $FIG_Config::dbpass;
19 :     $dbport = defined($dbport) ? $dbport : $FIG_Config::dbport;
20 :    
21 : olson 1.4 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 : efrank 1.1 my $dbh = DBI->connect( $data_source, $dbuser, $dbpass )
37 :     || die "ERROR: Could not connect to $data_source; ", DBI->errstr, "\n";
38 :     $dbh->{PrintError} = 1;
39 :     $dbh->{RaiseError} = 0;
40 :     if ($dbms eq "Pg")
41 :     {
42 :     $dbh->do(qq(SET "ENABLE_SEQSCAN" TO "OFF"));
43 :     $dbh->do(qq(SET DATESTYLE TO Postgres,US));
44 :     }
45 :    
46 :     bless {
47 :     _dbh => $dbh,
48 :     _dbms => $dbms,
49 :     }, $class;
50 :     }
51 :    
52 : olson 1.3 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 : efrank 1.1 sub SQL {
62 : olson 1.7 my($self, $sql, $verbose, @bind_values) = @_;
63 : efrank 1.1 my($dbh,$sth,$rc,$tmp);
64 :    
65 :     if ($verbose)
66 :     {
67 :     print STDERR "running: $sql\n";
68 :     }
69 :    
70 :     $dbh = $self->{_dbh};
71 : redwards 1.8
72 : olson 1.12 if ($sql =~ /^\s*select/i)
73 : efrank 1.1 {
74 : disz 1.14 eval {
75 : olson 1.7 $tmp = $dbh->selectall_arrayref($sql, undef, @bind_values);
76 :     };
77 : disz 1.14 if (!$tmp or $@)
78 : olson 1.7 {
79 : redwards 1.8 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 : olson 1.7 }
83 : efrank 1.1 return $tmp;
84 :     }
85 :     else
86 :     {
87 : olson 1.9 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 : efrank 1.1 # $sth = $dbh->prepare($sql)
100 :     # or die "prepare failed: $DBI::errstr";
101 :     # $sth->execute()
102 :     # or warn "execute failed: $DBI::errstr";
103 :     # return 1;
104 :     }
105 :     return undef;
106 :     }
107 :    
108 : olson 1.3 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 : efrank 1.1 sub drop_table {
129 :     my $self = shift @_;
130 :     my %arg = @_;
131 :     my $tbl = $arg{tbl};
132 :     my $dbh = $self->{_dbh};
133 :     my $dbms = $self->{_dbms};
134 :     my $cmd;
135 : olson 1.3
136 :    
137 :     if ($dbms eq "mysql")
138 :     {
139 :     $cmd = "DROP TABLE IF EXISTS $tbl;" ;
140 :     }
141 : olson 1.10 elsif ($dbms eq "Pg")
142 :     {
143 :     if ($self->table_exists($tbl))
144 :     {
145 :     $cmd = "DROP TABLE $tbl CASCADE;" ;
146 :     }
147 :     }
148 : olson 1.3 else
149 :     {
150 :     if ($self->table_exists($tbl))
151 :     {
152 :     $cmd = "DROP TABLE $tbl;" ;
153 :     }
154 :     }
155 :     if ($cmd)
156 :     {
157 :     $dbh->do($cmd);
158 :     }
159 : efrank 1.1 }
160 :    
161 :     sub create_table {
162 :     my $self = shift @_;
163 :     my %arg = @_;
164 :     my $tbl = $arg{tbl};
165 :     my $flds = $arg{flds};
166 :     my $dbh = $self->{_dbh};
167 :     my $dbms = $self->{_dbms};
168 : olson 1.15
169 :     my $type;
170 :    
171 :     if ($arg{type})
172 :     {
173 :     $type = " engine = $arg{type} ";
174 :     }
175 :     $dbh->do("CREATE TABLE $tbl ( $flds ) $type;");
176 : efrank 1.1 }
177 :    
178 :     sub load_table {
179 :     my $self = shift @_;
180 :     my %defaults = ( delim => "\t" );
181 :     my %arg = (%defaults, @_);
182 :     my $file = $arg{file};
183 :     my $tbl = $arg{tbl};
184 :     my $delim = $arg{delim};
185 :     my $dbh = $self->{_dbh};
186 :     my $dbms = $self->{_dbms};
187 : redwards 1.13 my $result;
188 :    
189 : efrank 1.1 if ($file)
190 :     {
191 :     if ($dbms eq "mysql")
192 :     {
193 : redwards 1.13 $result = $dbh->do("LOAD DATA LOCAL INFILE '$file' REPLACE INTO TABLE $tbl;");
194 : efrank 1.1 }
195 :     elsif ($dbms eq "Pg")
196 :     {
197 : redwards 1.13 $result = $dbh->do("COPY $tbl FROM '$file' USING DELIMITERS '$delim';");
198 : efrank 1.1 }
199 :     }
200 : redwards 1.13 return $result;
201 : efrank 1.1 }
202 :    
203 :     sub create_index {
204 :     my $self = shift @_;
205 :     my %arg = @_;
206 :     my $tbl = $arg{tbl};
207 :     my $idx = $arg{idx};
208 :     my $flds = $arg{flds};
209 :     my $type = $arg{type};
210 :     my $dbh = $self->{_dbh};
211 :     my $dbms = $self->{_dbms};
212 :     my $cmd = "CREATE INDEX $idx ON $tbl ";
213 :     if ($type && $dbms eq "Pg")
214 :     {
215 :     $cmd .= " USING $type ";
216 :     }
217 :     $cmd .= " ( $flds );";
218 :     $dbh->do($cmd);
219 :     }
220 :    
221 :     sub DESTROY {
222 :     my($self) = @_;
223 :    
224 :     my($dbh);
225 :     if ($dbh = $self->{_dbh})
226 :     {
227 :     $dbh->disconnect;
228 :     }
229 :     }
230 :    
231 :     sub vacuum_it {
232 :     my($self,@tables) = @_;
233 :     my($table);
234 :    
235 :     my $dbh = $self->{_dbh};
236 :     my $dbms = $self->{_dbms};
237 :     if ($dbms eq "mysql")
238 :     {
239 :     return;
240 :     }
241 :    
242 :     # this chunk is for Pg (Postgres)
243 :     if (@tables == 0)
244 :     {
245 :     $self->SQL("VACUUM ANALYZE");
246 :     }
247 :     else
248 :     {
249 :     foreach $table (@tables)
250 :     {
251 :     $self->SQL("VACUUM ANALYZE $table");
252 :     }
253 :     }
254 :     }
255 :    
256 : olson 1.11 =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 : olson 1.5 #
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 : olson 1.15 "--basedir=$FIG_Config::common_runtime",
342 : olson 1.5 "--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 : olson 1.6 push(@opts, "--old-password");
406 :     push(@opts, "--max-allowed-packet=128M");
407 : olson 1.5 #
408 :     # Oddly, this doesn't seem to work. need to set the environment variable.
409 :     #
410 :     #push(@opts, "--port=$FIG_Config::dbport");
411 :    
412 : olson 1.15 if (@FIG_Config::db_server_startup_options)
413 :     {
414 :     push(@opts, @FIG_Config::db_server_startup_options)
415 :     }
416 :    
417 : olson 1.5 #
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 : olson 1.15 print "Would run $exe @opts\n";
429 :    
430 : olson 1.5 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 : efrank 1.1 1

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3