Parent Directory
| 
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 |