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

Annotation of /FigKernelPackages/DBrtns.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3