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

Annotation of /FigKernelPackages/DBrtns.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6 - (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 :     my($self,$sql,$verbose) = @_;
63 :     my($dbh,$sth,$rc,$tmp);
64 :    
65 :     if ($verbose)
66 :     {
67 :     print STDERR "running: $sql\n";
68 :     }
69 :    
70 :     $dbh = $self->{_dbh};
71 :    
72 : olson 1.3 if ($sql =~ /^select/i)
73 : efrank 1.1 {
74 : olson 1.3 $tmp = $dbh->selectall_arrayref($sql);
75 : efrank 1.1 return $tmp;
76 :     }
77 :     else
78 :     {
79 :     return $dbh->do($sql);
80 :     # $sth = $dbh->prepare($sql)
81 :     # or die "prepare failed: $DBI::errstr";
82 :     # $sth->execute()
83 :     # or warn "execute failed: $DBI::errstr";
84 :     # return 1;
85 :     }
86 :     return undef;
87 :     }
88 :    
89 : olson 1.3 sub get_tables
90 :     {
91 :     my($self) = @_;
92 :    
93 :     my $dbh = $self->{_dbh};
94 :    
95 :     my $quote = $dbh->get_info(29); # SQL_IDENTIFIER_QUOTE_CHAR
96 :    
97 :     my @tables = $dbh->tables();
98 :    
99 :     return map { $quote ne "" && s/^$quote(.*)$quote$/$1/; s/^[^.]+\.//; $_ } @tables;
100 :     }
101 :    
102 :     sub table_exists
103 :     {
104 :     my($self, $table) = @_;
105 :    
106 :     return (grep { $table eq $_ } $self->get_tables()) > 0;
107 :     }
108 :    
109 : efrank 1.1 sub drop_table {
110 :     my $self = shift @_;
111 :     my %arg = @_;
112 :     my $tbl = $arg{tbl};
113 :     my $dbh = $self->{_dbh};
114 :     my $dbms = $self->{_dbms};
115 :     my $cmd;
116 : olson 1.3
117 :    
118 :     if ($dbms eq "mysql")
119 :     {
120 :     $cmd = "DROP TABLE IF EXISTS $tbl;" ;
121 :     }
122 :     else
123 :     {
124 :     if ($self->table_exists($tbl))
125 :     {
126 :     $cmd = "DROP TABLE $tbl;" ;
127 :     }
128 :     }
129 :     if ($cmd)
130 :     {
131 :     $dbh->do($cmd);
132 :     }
133 : efrank 1.1 }
134 :    
135 :     sub create_table {
136 :     my $self = shift @_;
137 :     my %arg = @_;
138 :     my $tbl = $arg{tbl};
139 :     my $flds = $arg{flds};
140 :     my $dbh = $self->{_dbh};
141 :     my $dbms = $self->{_dbms};
142 :     $dbh->do("CREATE TABLE $tbl ( $flds );");
143 :     }
144 :    
145 :     sub load_table {
146 :     my $self = shift @_;
147 :     my %defaults = ( delim => "\t" );
148 :     my %arg = (%defaults, @_);
149 :     my $file = $arg{file};
150 :     my $tbl = $arg{tbl};
151 :     my $delim = $arg{delim};
152 :     my $dbh = $self->{_dbh};
153 :     my $dbms = $self->{_dbms};
154 :    
155 :     if ($file)
156 :     {
157 :     if ($dbms eq "mysql")
158 :     {
159 :     $dbh->do("LOAD DATA LOCAL INFILE '$file' REPLACE INTO TABLE $tbl;");
160 :     }
161 :     elsif ($dbms eq "Pg")
162 :     {
163 :     $dbh->do("COPY $tbl FROM '$file' USING DELIMITERS '$delim';");
164 :     }
165 :     }
166 :     }
167 :    
168 :     sub create_index {
169 :     my $self = shift @_;
170 :     my %arg = @_;
171 :     my $tbl = $arg{tbl};
172 :     my $idx = $arg{idx};
173 :     my $flds = $arg{flds};
174 :     my $type = $arg{type};
175 :     my $dbh = $self->{_dbh};
176 :     my $dbms = $self->{_dbms};
177 :     my $cmd = "CREATE INDEX $idx ON $tbl ";
178 :     if ($type && $dbms eq "Pg")
179 :     {
180 :     $cmd .= " USING $type ";
181 :     }
182 :     $cmd .= " ( $flds );";
183 :     $dbh->do($cmd);
184 :     }
185 :    
186 :     sub DESTROY {
187 :     my($self) = @_;
188 :    
189 :     my($dbh);
190 :     if ($dbh = $self->{_dbh})
191 :     {
192 :     $dbh->disconnect;
193 :     }
194 :     }
195 :    
196 :     sub vacuum_it {
197 :     my($self,@tables) = @_;
198 :     my($table);
199 :    
200 :     my $dbh = $self->{_dbh};
201 :     my $dbms = $self->{_dbms};
202 :     if ($dbms eq "mysql")
203 :     {
204 :     return;
205 :     }
206 :    
207 :     # this chunk is for Pg (Postgres)
208 :     if (@tables == 0)
209 :     {
210 :     $self->SQL("VACUUM ANALYZE");
211 :     }
212 :     else
213 :     {
214 :     foreach $table (@tables)
215 :     {
216 :     $self->SQL("VACUUM ANALYZE $table");
217 :     }
218 :     }
219 :     }
220 :    
221 : olson 1.5 #
222 :     # Following are database administration routines. They create an instance of a ServerAdmin class
223 :     # for the appropriate server type (in order to eliminate the if mysql / if pg / etc stuff).
224 :     #
225 :    
226 :     sub get_server_admin
227 :     {
228 :     if ($FIG_Config::dbms eq "mysql")
229 :     {
230 :     return MysqlAdmin->new();
231 :     }
232 :     elsif ($FIG_Config::dbms eq "Pg")
233 :     {
234 :     return new PostgresAdmin();
235 :     }
236 :     else
237 :     {
238 :     warn "Unknown server type $FIG_Config::dbms\n";
239 :     return undef;
240 :     }
241 :     }
242 :     package MysqlAdmin;
243 :    
244 :     use POSIX;
245 :     use DBI;
246 :    
247 :     sub new
248 :     {
249 :     my($class) = @_;
250 :    
251 :     my $self = {};
252 :    
253 :     return bless($self, $class);
254 :     }
255 :    
256 :     sub init_db
257 :     {
258 :     my($self, $db_dir) = @_;
259 :    
260 :     if (!$db_dir)
261 :     {
262 :     warn "init_db failed: db_dir must be provided\n";
263 :     return;
264 :     }
265 :    
266 :     if (-d "$db_dir/mysql")
267 :     {
268 :     warn "init_db: mysql data directory already exists\n";
269 :     return;
270 :     }
271 :    
272 :     my $exe = "$FIG_Config::ext_bin/mysql_install_db";
273 :     if (! -x $exe)
274 :     {
275 :     $exe = "mysql_install_db";
276 :     }
277 :    
278 :     my $rc = system($exe,
279 :     "--datadir=$db_dir",
280 :     "--user=$FIG_Config::dbuser");
281 :     if ($rc != 0)
282 :     {
283 :     my $err = $?;
284 :     if (WIFEXITED($err))
285 :     {
286 :     my $exitstat = WEXITSTATUS($err);
287 :     warn "init_db failed: $exe returned result code $exitstat\n";
288 :     }
289 :     else
290 :     {
291 :     warn "init_db failed: $exe died with signal ", WTERMSIG($err), "\n";
292 :     }
293 :     return;
294 :     }
295 :    
296 :     return 1;
297 :     }
298 :    
299 :     sub create_database
300 :     {
301 :     my($self, $db_name) = @_;
302 :    
303 :     my $drh = DBI->install_driver("mysql");
304 :    
305 :     my @dbs = DBI->data_sources("mysql", { host => $FIG_Config::dbhost,
306 :     user => $FIG_Config::dbuser,
307 :     password => $FIG_Config::dbpass });
308 :     if (grep { $_ eq $db_name } @dbs)
309 :     {
310 :     warn "Database $db_name already exists\n";
311 :     return;
312 :     }
313 :    
314 :     my $rc = $drh->func('createdb', $db_name, $FIG_Config::dbhost,
315 :     $FIG_Config::dbuser, $FIG_Config::dbpass, 'admin');
316 :    
317 :    
318 :     if (!$rc)
319 :     {
320 :     warn "create_database: createdb call failed: $DBI::errstr\n";
321 :     return;
322 :     }
323 :    
324 :     return 1;
325 :     }
326 :    
327 :     sub start_server
328 :     {
329 :     my($self) = @_;
330 :    
331 :     print "Starting mysql server\n";
332 :    
333 :     my(@opts);
334 :    
335 :     push(@opts, "--port=$FIG_Config::dbport");
336 :     #
337 :     # Don't do this; dbuser isn't the unix uid that we are using.
338 :     #
339 :     #push(@opts, "--user=$FIG_Config::dbuser");
340 :     push(@opts, "--basedir=$FIG_Config::common_runtime");
341 :     push(@opts, "--datadir=$FIG_Config::db_datadir");
342 :     push(@opts, "--ledir=$FIG_Config::common_runtime/libexec");
343 : olson 1.6 push(@opts, "--old-password");
344 :     push(@opts, "--max-allowed-packet=128M");
345 : olson 1.5 #
346 :     # Oddly, this doesn't seem to work. need to set the environment variable.
347 :     #
348 :     #push(@opts, "--port=$FIG_Config::dbport");
349 :    
350 :     #
351 :     # We are going to assume that if mysql has shipped with this release, we'll use it. Otherwise
352 :     # try to use a system one.
353 :     #
354 :    
355 :     my $exe = "$FIG_Config::ext_bin/mysqld_safe";
356 :     if (! -x $exe)
357 :     {
358 :     $exe = "mysqld_safe";
359 :     }
360 :    
361 :     my $pid = fork;
362 :    
363 :     if ($pid == 0)
364 :     {
365 :     POSIX::setsid();
366 :    
367 :     $ENV{MYSQL_TCP_PORT} = $FIG_Config::dbport;
368 :     exec $exe, @opts;
369 :     }
370 :    
371 :     print "Forked db server $pid\n";
372 :     }
373 :    
374 :    
375 : efrank 1.1 1

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3