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

Annotation of /FigKernelPackages/DBrtns.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : efrank 1.1 package DBrtns;
2 :    
3 : parrello 1.18 # Inherit the DBKernel methods. We must do this BEFORE the "use strict".
4 :     use DBKernel;
5 :     @ISA = qw(DBKernel);
6 :    
7 : efrank 1.1 use strict;
8 : olson 1.5 use POSIX;
9 : efrank 1.1 use DBI;
10 :     use FIG_Config;
11 :    
12 :     use Data::Dumper;
13 : overbeek 1.2 use Carp;
14 :    
15 :     sub new {
16 : efrank 1.1 my($class,$dbms,$dbname,$dbuser,$dbpass,$dbport) = @_;
17 :    
18 :     $dbms = defined($dbms) ? $dbms : $FIG_Config::dbms;
19 :     $dbname = defined($dbname) ? $dbname : $FIG_Config::db;
20 :     $dbuser = defined($dbuser) ? $dbuser : $FIG_Config::dbuser;
21 :     $dbpass = defined($dbpass) ? $dbpass : $FIG_Config::dbpass;
22 :     $dbport = defined($dbport) ? $dbport : $FIG_Config::dbport;
23 :    
24 : parrello 1.18 return DBKernel::new($class, $dbms, $dbname, $dbuser, $dbpass, $dbport);
25 : efrank 1.1 }
26 :    
27 :     sub vacuum_it {
28 :     my($self,@tables) = @_;
29 :     my($table);
30 :    
31 :     my $dbh = $self->{_dbh};
32 :     my $dbms = $self->{_dbms};
33 : parrello 1.18 if ($dbms eq "mysql") {
34 : efrank 1.1 return;
35 :     }
36 :    
37 :     # this chunk is for Pg (Postgres)
38 : parrello 1.18 if (@tables == 0) {
39 :     $self->SQL("VACUUM ANALYZE");
40 :     } else {
41 :     foreach $table (@tables) {
42 :     $self->SQL("VACUUM ANALYZE $table");
43 :     }
44 : efrank 1.1 }
45 :     }
46 :    
47 : olson 1.11 =head1 get_inserted_id
48 :    
49 :     Return the last ID of a row inserted into an autonumber/serial-containing table.
50 :    
51 :     =cut
52 :    
53 : parrello 1.18 sub get_inserted_id {
54 : olson 1.11 my($self, $table, $sth) = @_;
55 : parrello 1.18 if ($self->{_dbms} eq "Pg") {
56 :     my $oid = $sth->{pg_oid_status};
57 :     my $ret = $self->SQL("select id from $table where oid = ?", undef, $oid);
58 :     return $ret->[0]->[0];
59 :     } elsif ($self->{_dbms} eq "mysql") {
60 :     my $id = $self->{_dbh}->{mysql_insertid};
61 :     # print "mysql got $id\n";
62 :     return $id;
63 : olson 1.11 }
64 :     }
65 :    
66 : olson 1.5 #
67 :     # Following are database administration routines. They create an instance of a ServerAdmin class
68 :     # for the appropriate server type (in order to eliminate the if mysql / if pg / etc stuff).
69 :     #
70 :    
71 :     sub get_server_admin
72 :     {
73 :     if ($FIG_Config::dbms eq "mysql")
74 :     {
75 :     return MysqlAdmin->new();
76 :     }
77 :     elsif ($FIG_Config::dbms eq "Pg")
78 :     {
79 :     return new PostgresAdmin();
80 :     }
81 :     else
82 :     {
83 :     warn "Unknown server type $FIG_Config::dbms\n";
84 :     return undef;
85 :     }
86 :     }
87 :     package MysqlAdmin;
88 :    
89 :     use POSIX;
90 :     use DBI;
91 :    
92 :     sub new
93 :     {
94 :     my($class) = @_;
95 :    
96 :     my $self = {};
97 :    
98 :     return bless($self, $class);
99 :     }
100 :    
101 :     sub init_db
102 :     {
103 :     my($self, $db_dir) = @_;
104 :    
105 :     if (!$db_dir)
106 :     {
107 :     warn "init_db failed: db_dir must be provided\n";
108 :     return;
109 :     }
110 :    
111 :     if (-d "$db_dir/mysql")
112 :     {
113 :     warn "init_db: mysql data directory already exists\n";
114 :     return;
115 :     }
116 :    
117 :     my $exe = "$FIG_Config::ext_bin/mysql_install_db";
118 :     if (! -x $exe)
119 :     {
120 :     $exe = "mysql_install_db";
121 : parrello 1.18 }
122 : olson 1.5
123 :     my $rc = system($exe,
124 :     "--datadir=$db_dir",
125 : olson 1.15 "--basedir=$FIG_Config::common_runtime",
126 : olson 1.5 "--user=$FIG_Config::dbuser");
127 :     if ($rc != 0)
128 :     {
129 :     my $err = $?;
130 :     if (WIFEXITED($err))
131 :     {
132 :     my $exitstat = WEXITSTATUS($err);
133 :     warn "init_db failed: $exe returned result code $exitstat\n";
134 :     }
135 :     else
136 :     {
137 :     warn "init_db failed: $exe died with signal ", WTERMSIG($err), "\n";
138 :     }
139 :     return;
140 :     }
141 :    
142 :     return 1;
143 :     }
144 :    
145 :     sub create_database
146 :     {
147 :     my($self, $db_name) = @_;
148 :    
149 :     my $drh = DBI->install_driver("mysql");
150 :    
151 :     my @dbs = DBI->data_sources("mysql", { host => $FIG_Config::dbhost,
152 :     user => $FIG_Config::dbuser,
153 :     password => $FIG_Config::dbpass });
154 :     if (grep { $_ eq $db_name } @dbs)
155 :     {
156 :     warn "Database $db_name already exists\n";
157 :     return;
158 :     }
159 :    
160 :     my $rc = $drh->func('createdb', $db_name, $FIG_Config::dbhost,
161 :     $FIG_Config::dbuser, $FIG_Config::dbpass, 'admin');
162 : parrello 1.18
163 : olson 1.5
164 :     if (!$rc)
165 :     {
166 :     warn "create_database: createdb call failed: $DBI::errstr\n";
167 :     return;
168 :     }
169 : parrello 1.18
170 : olson 1.5 return 1;
171 :     }
172 :    
173 :     sub start_server
174 :     {
175 : olson 1.16 my($self, $dont_fork) = @_;
176 : olson 1.5
177 :     print "Starting mysql server\n";
178 :    
179 :     my(@opts);
180 :    
181 :     push(@opts, "--port=$FIG_Config::dbport");
182 :     #
183 :     # Don't do this; dbuser isn't the unix uid that we are using.
184 :     #
185 :     #push(@opts, "--user=$FIG_Config::dbuser");
186 :     push(@opts, "--basedir=$FIG_Config::common_runtime");
187 :     push(@opts, "--datadir=$FIG_Config::db_datadir");
188 :     push(@opts, "--ledir=$FIG_Config::common_runtime/libexec");
189 : olson 1.6 push(@opts, "--old-password");
190 :     push(@opts, "--max-allowed-packet=128M");
191 : olson 1.5 #
192 :     # Oddly, this doesn't seem to work. need to set the environment variable.
193 :     #
194 :     #push(@opts, "--port=$FIG_Config::dbport");
195 :    
196 : olson 1.15 if (@FIG_Config::db_server_startup_options)
197 :     {
198 :     push(@opts, @FIG_Config::db_server_startup_options)
199 :     }
200 :    
201 : olson 1.5 #
202 :     # We are going to assume that if mysql has shipped with this release, we'll use it. Otherwise
203 :     # try to use a system one.
204 :     #
205 :    
206 :     my $exe = "$FIG_Config::ext_bin/mysqld_safe";
207 :     if (! -x $exe)
208 :     {
209 :     $exe = "mysqld_safe";
210 :     }
211 :    
212 : olson 1.16 if ($dont_fork)
213 : olson 1.5 {
214 :     $ENV{MYSQL_TCP_PORT} = $FIG_Config::dbport;
215 :     exec $exe, @opts;
216 :     }
217 : olson 1.16 else
218 :     {
219 :     my $pid = fork;
220 :    
221 :     if ($pid == 0)
222 :     {
223 :     POSIX::setsid();
224 : parrello 1.18
225 : olson 1.16 $ENV{MYSQL_TCP_PORT} = $FIG_Config::dbport;
226 :     exec $exe, @opts;
227 :     }
228 :     print "Forked db server $pid\n";
229 :     }
230 : olson 1.5
231 :     }
232 :    
233 : parrello 1.18 1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3