|
Line 0
Link Here
|
|
|
1 |
package C4::Update::Database; |
| 2 |
|
| 3 |
# Copyright Biblibre 2012 |
| 4 |
# |
| 5 |
# This file is part of Koha. |
| 6 |
# |
| 7 |
# Koha is free software; you can redistribute it and/or modify it under the |
| 8 |
# terms of the GNU General Public License as published by the Free Software |
| 9 |
# Foundation; either version 2 of the License, or (at your option) any later |
| 10 |
# version. |
| 11 |
# |
| 12 |
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY |
| 13 |
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR |
| 14 |
# A PARTICULAR PURPOSE. See the GNU General Public License for more details. |
| 15 |
# |
| 16 |
# You should have received a copy of the GNU General Public License along |
| 17 |
# with Koha; if not, write to the Free Software Foundation, Inc., |
| 18 |
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. |
| 19 |
|
| 20 |
use Modern::Perl; |
| 21 |
|
| 22 |
use C4::Context; |
| 23 |
|
| 24 |
use File::Basename; |
| 25 |
use File::Find::Rule; |
| 26 |
use Digest::MD5; |
| 27 |
use List::MoreUtils qw/uniq/; |
| 28 |
use YAML; |
| 29 |
|
| 30 |
=head1 NAME |
| 31 |
|
| 32 |
C4::Update::Database.pm |
| 33 |
|
| 34 |
=head1 SYNOPSIS |
| 35 |
|
| 36 |
use C4::Update::Database; |
| 37 |
|
| 38 |
This package is used by admin/updatedatabase.pl, to manage DB updates |
| 39 |
|
| 40 |
=head1 FUNCTIONS |
| 41 |
|
| 42 |
=cut |
| 43 |
|
| 44 |
my $VERSIONS_PATH = C4::Context->config('intranetdir') . '/installer/data/mysql/versions'; |
| 45 |
|
| 46 |
my $version; |
| 47 |
my $list; |
| 48 |
|
| 49 |
my $dbh = C4::Context->dbh; |
| 50 |
|
| 51 |
=head2 get_filepath |
| 52 |
|
| 53 |
my $file = get_filepath($version); |
| 54 |
this sub will return the full path of a given DB update number |
| 55 |
|
| 56 |
=cut |
| 57 |
|
| 58 |
sub get_filepath { |
| 59 |
my ( $version ) = @_; |
| 60 |
my @files = File::Find::Rule->file->name( "$version.sql", "$version.pl" ) ->in( ( $VERSIONS_PATH ) ); |
| 61 |
|
| 62 |
if ( scalar @files != 1 ) { |
| 63 |
die "This version ($version) returned has ".scalar @files." corresponding, need only 1"; |
| 64 |
} |
| 65 |
|
| 66 |
return $files[0]; |
| 67 |
} |
| 68 |
|
| 69 |
=head2 get_md5 |
| 70 |
|
| 71 |
my $md5 = get_md5($filepath) |
| 72 |
returns the md5sum of the selected file. |
| 73 |
This is used to check consistency of updates |
| 74 |
|
| 75 |
=cut |
| 76 |
|
| 77 |
sub get_md5 { |
| 78 |
my ( $filepath ) = @_; |
| 79 |
open(FILE, $filepath); |
| 80 |
|
| 81 |
my $ctx = Digest::MD5->new; |
| 82 |
$ctx->addfile(*FILE); |
| 83 |
my $md5 = $ctx->hexdigest; |
| 84 |
close(FILE); |
| 85 |
return $md5; |
| 86 |
} |
| 87 |
|
| 88 |
=head2 execute_version |
| 89 |
|
| 90 |
$result = execute_version($version_number); |
| 91 |
Execute an update. |
| 92 |
This sub will detect if the number is made through a .pl or a .sql, and behave accordingly |
| 93 |
if there is more than 1 file with the same number, an error will be issued |
| 94 |
if you try to execute a version_number that has already be executed, then it will also issue an error |
| 95 |
the sub return an result hash, with the version number and the result |
| 96 |
|
| 97 |
=cut |
| 98 |
|
| 99 |
sub execute_version { |
| 100 |
my ( $version ) = @_; |
| 101 |
my $report; |
| 102 |
|
| 103 |
my $filepath; |
| 104 |
eval { |
| 105 |
$filepath = get_filepath $version; |
| 106 |
}; |
| 107 |
if ( $@ ) { |
| 108 |
return { $version => $@ }; |
| 109 |
} |
| 110 |
|
| 111 |
my @file_infos = fileparse( $filepath, qr/\.[^.]*/ ); |
| 112 |
my $extension = $file_infos[2]; |
| 113 |
my $filename = $version . $extension; |
| 114 |
|
| 115 |
my $md5 = get_md5 $filepath; |
| 116 |
my $r = md5_already_exists( $md5 ); |
| 117 |
if ( scalar @$r ) { |
| 118 |
my $p = @$r[0]; |
| 119 |
$report->{$version} = { |
| 120 |
error => "ALREADY_EXISTS", |
| 121 |
filepath => $filepath, |
| 122 |
old_version => @$r[0]->{version}, |
| 123 |
md5 => @$r[0]->{md5}, |
| 124 |
}; |
| 125 |
return $report; |
| 126 |
} |
| 127 |
|
| 128 |
my $queries; |
| 129 |
given ( $extension ) { |
| 130 |
when ( /.sql/ ) { |
| 131 |
$queries = get_queries ( $filepath ); |
| 132 |
} |
| 133 |
when ( /.pl/ ) { |
| 134 |
eval { |
| 135 |
$queries = get_queries ( $filepath ); |
| 136 |
}; |
| 137 |
if ($@) { |
| 138 |
$report->{$version} = { |
| 139 |
error => "LOAD_FUNCTIONS_FAILED", |
| 140 |
filename => $filename, |
| 141 |
error_str => $@, |
| 142 |
}; |
| 143 |
} |
| 144 |
} |
| 145 |
default { |
| 146 |
$report->{$version} = { |
| 147 |
error => "BAD_EXTENSION", |
| 148 |
extension => $extension, |
| 149 |
}; |
| 150 |
} |
| 151 |
} |
| 152 |
|
| 153 |
return $report |
| 154 |
if ( defined $report->{$version} ); |
| 155 |
|
| 156 |
my $errors = execute ( $queries ); |
| 157 |
$report->{$version} = scalar( @$errors ) ? $errors : "OK"; |
| 158 |
set_infos ( $version, $queries, $errors, $md5 ); |
| 159 |
return $report; |
| 160 |
} |
| 161 |
|
| 162 |
=head2 list_versions_available |
| 163 |
|
| 164 |
my @versions = list_versions_available; |
| 165 |
return an array with all version available |
| 166 |
|
| 167 |
=cut |
| 168 |
|
| 169 |
sub list_versions_available { |
| 170 |
my @versions; |
| 171 |
|
| 172 |
my @files = File::Find::Rule->file->name( "*.sql", "*.pl" ) ->in( ( $VERSIONS_PATH ) ); |
| 173 |
|
| 174 |
for my $f ( @files ) { |
| 175 |
my @file_infos = fileparse( $f, qr/\.[^.]*/ ); |
| 176 |
push @versions, $file_infos[0]; |
| 177 |
} |
| 178 |
@versions = uniq @versions; |
| 179 |
return \@versions; |
| 180 |
} |
| 181 |
|
| 182 |
=head2 list_versions_already_applied |
| 183 |
|
| 184 |
my @versions = list_versions_available; |
| 185 |
return an array with all version that have already been applied |
| 186 |
This sub check first that the updatedb tables exist and create them if needed |
| 187 |
|
| 188 |
=cut |
| 189 |
|
| 190 |
sub list_versions_already_applied { |
| 191 |
# 1st check if tables exist, otherwise create them |
| 192 |
$dbh->do(qq{ |
| 193 |
CREATE TABLE IF NOT EXISTS `updatedb_error` ( `version` varchar(32) DEFAULT NULL, `error` text ) ENGINE=InnoDB CHARSET=utf8; |
| 194 |
}); |
| 195 |
$dbh->do(qq{ |
| 196 |
CREATE TABLE IF NOT EXISTS `updatedb_query` ( `version` varchar(32) DEFAULT NULL, `query` text ) ENGINE=InnoDB CHARSET=utf8; |
| 197 |
}); |
| 198 |
$dbh->do(qq{ |
| 199 |
CREATE TABLE IF NOT EXISTS `updatedb_report` ( `version` text, `md5` varchar(50) DEFAULT NULL, `comment` text, `status` int(1) DEFAULT NULL ) ENGINE=InnoDB CHARSET=utf8; |
| 200 |
}); |
| 201 |
|
| 202 |
my $query = qq/ SELECT version, comment, status FROM updatedb_report ORDER BY version/; |
| 203 |
my $sth = $dbh->prepare( $query ); |
| 204 |
$sth->execute; |
| 205 |
my $versions = $sth->fetchall_arrayref( {} ); |
| 206 |
map { |
| 207 |
my $version = $_; |
| 208 |
my @comments = defined $_->{comment} ? split '\\\n', $_->{comment} : ""; |
| 209 |
push @{ $version->{comments} }, { comment => $_ } for @comments; |
| 210 |
delete $version->{comment}; |
| 211 |
} @$versions; |
| 212 |
$sth->finish; |
| 213 |
for my $version ( @$versions ) { |
| 214 |
$query = qq/ SELECT query FROM updatedb_query WHERE version = ? ORDER BY version/; |
| 215 |
$sth = $dbh->prepare( $query ); |
| 216 |
$sth->execute( $version->{version} ); |
| 217 |
$version->{queries} = $sth->fetchall_arrayref( {} ); |
| 218 |
$sth->finish; |
| 219 |
$query = qq/ SELECT error FROM updatedb_error WHERE version = ? ORDER BY version/; |
| 220 |
$sth = $dbh->prepare( $query ); |
| 221 |
$sth->execute( $version->{version} ); |
| 222 |
$version->{errors} = $sth->fetchall_arrayref( {} ); |
| 223 |
$sth->finish; |
| 224 |
} |
| 225 |
return $versions; |
| 226 |
} |
| 227 |
|
| 228 |
=head2 execute |
| 229 |
|
| 230 |
my @errors = $execute(\@queries); |
| 231 |
This sub will execute queries coming from an execute_version based on a .sql file |
| 232 |
|
| 233 |
=cut |
| 234 |
|
| 235 |
sub execute { |
| 236 |
my ( $queries ) = @_; |
| 237 |
my @errors; |
| 238 |
for my $query ( @{$queries->{queries}} ) { |
| 239 |
eval { |
| 240 |
$dbh->do( $query ); |
| 241 |
}; |
| 242 |
push @errors, get_error(); |
| 243 |
} |
| 244 |
return \@errors; |
| 245 |
} |
| 246 |
|
| 247 |
=head2 get_tables_name |
| 248 |
|
| 249 |
my $tables = get_tables_name; |
| 250 |
return an array with all Koha mySQL table names |
| 251 |
|
| 252 |
=cut |
| 253 |
|
| 254 |
sub get_tables_name { |
| 255 |
my $sth = $dbh->prepare("SHOW TABLES"); |
| 256 |
$sth->execute(); |
| 257 |
my @tables; |
| 258 |
while ( my ( $table ) = $sth->fetchrow_array ) { |
| 259 |
push @tables, $table; |
| 260 |
} |
| 261 |
return \@tables; |
| 262 |
} |
| 263 |
my $tables; |
| 264 |
|
| 265 |
=head2 check_coherency |
| 266 |
|
| 267 |
my $errors = check_coherency($query); UNUSED |
| 268 |
This sub will try to check if a SQL query is useless or no. |
| 269 |
for queries that are CREATE TABLE, it will check if the table already exists |
| 270 |
for queries that are ALTER TABLE, it will search if the modification has already been made |
| 271 |
for queries that are INSERT, it will search if the insert has already been made if it's a syspref or a permission |
| 272 |
|
| 273 |
Those test cover 90% of the updatedatabases cases. That will help finding duplicate or inconsistencies |
| 274 |
|
| 275 |
=cut |
| 276 |
|
| 277 |
#sub check_coherency { |
| 278 |
# my ( $query ) = @_; |
| 279 |
# $tables = get_tables_name() if not $tables; |
| 280 |
# |
| 281 |
# given ( $query ) { |
| 282 |
# when ( /CREATE TABLE(?:.*?)? `?(\w+)`?/ ) { |
| 283 |
# my $table_name = $1; |
| 284 |
# if ( grep { /$table_name/ } @$tables ) { |
| 285 |
# die "COHERENCY: Table $table_name already exists"; |
| 286 |
# } |
| 287 |
# } |
| 288 |
# |
| 289 |
# when ( /ALTER TABLE *`?(\w+)`? *ADD *(?:COLUMN)? `?(\w+)`?/ ) { |
| 290 |
# my $table_name = $1; |
| 291 |
# my $column_name = $2; |
| 292 |
# next if $column_name =~ /(UNIQUE|CONSTRAINT|INDEX|KEY|FOREIGN)/; |
| 293 |
# if ( not grep { /$table_name/ } @$tables ) { |
| 294 |
# return "COHERENCY: Table $table_name does not exist"; |
| 295 |
# } else { |
| 296 |
# my $sth = $dbh->prepare( "DESC $table_name $column_name" ); |
| 297 |
# my $rv = $sth->execute; |
| 298 |
# if ( $rv > 0 ) { |
| 299 |
# die "COHERENCY: Field $table_name.$column_name already exists"; |
| 300 |
# } |
| 301 |
# } |
| 302 |
# } |
| 303 |
# |
| 304 |
# when ( /INSERT INTO `?(\w+)`?.*?VALUES *\((.*?)\)/ ) { |
| 305 |
# my $table_name = $1; |
| 306 |
# my @values = split /,/, $2; |
| 307 |
# s/^ *'// foreach @values; |
| 308 |
# s/' *$// foreach @values; |
| 309 |
# given ( $table_name ) { |
| 310 |
# when ( /systempreferences/ ) { |
| 311 |
# my $syspref = $values[0]; |
| 312 |
# my $sth = $dbh->prepare( "SELECT COUNT(*) FROM systempreferences WHERE variable = ?" ); |
| 313 |
# $sth->execute( $syspref ); |
| 314 |
# if ( ( my $count = $sth->fetchrow_array ) > 0 ) { |
| 315 |
# die "COHERENCY: Syspref $syspref already exists"; |
| 316 |
# } |
| 317 |
# } |
| 318 |
# |
| 319 |
# when ( /permissions/){ |
| 320 |
# my $module_bit = $values[0]; |
| 321 |
# my $code = $values[1]; |
| 322 |
# my $sth = $dbh->prepare( "SELECT COUNT(*) FROM permissions WHERE module_bit = ? AND code = ?" ); |
| 323 |
# $sth->execute($module_bit, $code); |
| 324 |
# if ( ( my $count = $sth->fetchrow_array ) > 0 ) { |
| 325 |
# die "COHERENCY: Permission $code already exists"; |
| 326 |
# } |
| 327 |
# } |
| 328 |
# } |
| 329 |
# } |
| 330 |
# } |
| 331 |
# return 1; |
| 332 |
#} |
| 333 |
|
| 334 |
=head2 get_error |
| 335 |
|
| 336 |
my $errors = get_error() |
| 337 |
This sub will return any mySQL error that occured during an update |
| 338 |
|
| 339 |
=cut |
| 340 |
|
| 341 |
sub get_error { |
| 342 |
my @errors = $dbh->selectrow_array(qq{SHOW ERRORS}); # Get errors |
| 343 |
my @warnings = $dbh->selectrow_array(qq{SHOW WARNINGS}); # Get warnings |
| 344 |
if ( @errors ) { # Catch specifics errors |
| 345 |
return qq{$errors[0] : $errors[1] => $errors[2]}; |
| 346 |
} elsif ( @warnings ) { |
| 347 |
return qq{$warnings[0] : $warnings[1] => $warnings[2]} |
| 348 |
if $warnings[0] ne 'Note'; |
| 349 |
} |
| 350 |
return; |
| 351 |
} |
| 352 |
|
| 353 |
=head2 get_queries |
| 354 |
|
| 355 |
my $result = get_queries($filepath); |
| 356 |
this sub will return a hashref with 2 entries: |
| 357 |
$result->{queries} is an array with all queries to execute |
| 358 |
$result->{comments} is an array with all comments in the .sql file |
| 359 |
|
| 360 |
=cut |
| 361 |
|
| 362 |
sub get_queries { |
| 363 |
my ( $filepath ) = @_; |
| 364 |
open my $fh, "<", $filepath; |
| 365 |
my @queries; |
| 366 |
my @comments; |
| 367 |
if ( $filepath =~ /\.pl$/ ) { |
| 368 |
if ( do $filepath ) { |
| 369 |
my $infos = _get_queries(); |
| 370 |
@queries = @{ $infos->{queries} } if exists $infos->{queries}; |
| 371 |
@comments = @{ $infos->{comments} } if exists $infos->{comments}; |
| 372 |
} |
| 373 |
if ( $@ ) { |
| 374 |
die "I can't load $filepath. Please check the execute flag and if this file is a valid perl script ($@)"; |
| 375 |
} |
| 376 |
} else { |
| 377 |
my $old_delimiter = $/; |
| 378 |
while ( <$fh> ) { |
| 379 |
my $line = $_; |
| 380 |
chomp $line; |
| 381 |
$line =~ s/^\s*//; |
| 382 |
if ( $line =~ /^--/ ) { |
| 383 |
my @l = split $old_delimiter, $line; |
| 384 |
if ( @l > 1 ) { |
| 385 |
my $tmp_query; |
| 386 |
for my $l ( @l ) { |
| 387 |
if ( $l =~ /^--/ ) { |
| 388 |
$l =~ s/^--\s*//; |
| 389 |
push @comments, $l; |
| 390 |
next; |
| 391 |
} |
| 392 |
$tmp_query .= $l . $old_delimiter; |
| 393 |
} |
| 394 |
push @queries, $tmp_query if $tmp_query; |
| 395 |
next; |
| 396 |
} |
| 397 |
|
| 398 |
$line =~ s/^--\s*//; |
| 399 |
push @comments, $line; |
| 400 |
next; |
| 401 |
} |
| 402 |
if ( $line =~ /^delimiter (.*)$/i ) { |
| 403 |
$/ = $1; |
| 404 |
next; |
| 405 |
} |
| 406 |
$line =~ s#$/##; |
| 407 |
push @queries, $line if not $line =~ /^\s*$/; # Push if query is not empty |
| 408 |
} |
| 409 |
$/ = $old_delimiter; |
| 410 |
close $fh; |
| 411 |
} |
| 412 |
|
| 413 |
return { queries => \@queries, comments => \@comments }; |
| 414 |
} |
| 415 |
|
| 416 |
=head2 md5_already_exists |
| 417 |
|
| 418 |
my $result = md5_already_exists($md5); |
| 419 |
check if the md5 of an update has already been applied on the database. |
| 420 |
If yes, it will return a hash with the version related to this md5 |
| 421 |
|
| 422 |
=cut |
| 423 |
|
| 424 |
sub md5_already_exists { |
| 425 |
my ( $md5 ) = @_; |
| 426 |
my $query = qq/SELECT version, md5 FROM updatedb_report WHERE md5 = ?/; |
| 427 |
my $sth = $dbh->prepare( $query ); |
| 428 |
$sth->execute( $md5 ); |
| 429 |
my @r; |
| 430 |
while ( my ( $version, $md5 ) = $sth->fetchrow ) { |
| 431 |
push @r, { version => $version, md5 => $md5 }; |
| 432 |
} |
| 433 |
$sth->finish; |
| 434 |
return \@r; |
| 435 |
} |
| 436 |
|
| 437 |
=head2 set_infos |
| 438 |
|
| 439 |
set_info($version,$queries, $error, $md5); |
| 440 |
this sub will insert into the updatedb tables what has been made on the database (queries, errors, result) |
| 441 |
|
| 442 |
=cut |
| 443 |
|
| 444 |
sub set_infos { |
| 445 |
my ( $version, $queries, $errors, $md5 ) = @_; |
| 446 |
SetVersion($version) if not -s $errors; |
| 447 |
for my $query ( @{ $queries->{queries} } ) { |
| 448 |
my $sth = $dbh->prepare("INSERT INTO updatedb_query(version, query) VALUES (?, ?)"); |
| 449 |
$sth->execute( $version, $query ); |
| 450 |
$sth->finish; |
| 451 |
} |
| 452 |
for my $error ( @$errors ) { |
| 453 |
my $sth = $dbh->prepare("INSERT INTO updatedb_error(version, error) VALUES (?, ?)"); |
| 454 |
$sth->execute( $version, $error ); |
| 455 |
} |
| 456 |
my $sth = $dbh->prepare("INSERT INTO updatedb_report(version, md5, comment, status) VALUES (?, ?, ?, ?)"); |
| 457 |
$sth->execute( |
| 458 |
$version, |
| 459 |
$md5, |
| 460 |
join ('\n', @{ $queries->{comments} }), |
| 461 |
( @$errors > 0 ) ? 0 : 1 |
| 462 |
); |
| 463 |
} |
| 464 |
|
| 465 |
=head2 mark_as_ok |
| 466 |
|
| 467 |
mark_as_ok($version); |
| 468 |
this sub will force to mark as "OK" an update that has failed |
| 469 |
once this has been made, the status will look as "forced OK", and appear in green like versions that have been applied without any problem |
| 470 |
|
| 471 |
=cut |
| 472 |
|
| 473 |
sub mark_as_ok { |
| 474 |
my ( $version ) = @_; |
| 475 |
my $sth = $dbh->prepare( "UPDATE updatedb_report SET status = 2 WHERE version=?" ); |
| 476 |
my $affected = $sth->execute( $version ); |
| 477 |
if ( $affected < 1 ) { |
| 478 |
my $filepath = get_filepath $version; |
| 479 |
my $queries = get_queries $filepath; |
| 480 |
my $md5 = get_md5 $filepath; |
| 481 |
set_infos $version, $queries, undef, $md5; |
| 482 |
|
| 483 |
$sth->execute( $version ); |
| 484 |
} |
| 485 |
$sth->finish; |
| 486 |
} |
| 487 |
|
| 488 |
=head2 is_uptodate |
| 489 |
is_uptodate(); |
| 490 |
return 1 if the database is up to date else 0. |
| 491 |
The database is up to date if all versions are excecuted. |
| 492 |
|
| 493 |
=cut |
| 494 |
|
| 495 |
sub is_uptodate { |
| 496 |
my $versions_available = C4::Update::Database::list_versions_available; |
| 497 |
my $versions = C4::Update::Database::list_versions_already_applied; |
| 498 |
for my $v ( @$versions_available ) { |
| 499 |
if ( not grep { $v eq $$_{version} } @$versions ) { |
| 500 |
return 0; |
| 501 |
} |
| 502 |
} |
| 503 |
return 1; |
| 504 |
} |
| 505 |
|
| 506 |
=head2 TransformToNum |
| 507 |
|
| 508 |
Transform the Koha version from a 4 parts string |
| 509 |
to a number, with just 1 . (ie: it's a number) |
| 510 |
|
| 511 |
=cut |
| 512 |
|
| 513 |
sub TransformToNum { |
| 514 |
my $version = shift; |
| 515 |
|
| 516 |
# remove the 3 last . to have a Perl number |
| 517 |
$version =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/; |
| 518 |
$version =~ s/Bug(\d+)/$1/; |
| 519 |
return $version; |
| 520 |
} |
| 521 |
|
| 522 |
sub SetVersion { |
| 523 |
my $new_version = TransformToNum(shift); |
| 524 |
return unless $new_version =~ /\d\.\d+/; |
| 525 |
my $current_version = TransformToNum( C4::Context->preference('Version') ); |
| 526 |
unless ( C4::Context->preference('Version') ) { |
| 527 |
my $finish = $dbh->prepare(qq{ |
| 528 |
INSERT IGNORE INTO systempreferences (variable,value,explanation) |
| 529 |
VALUES ('Version',?,'The Koha database version. WARNING: Do not change this value manually, it is maintained by the webinstaller') |
| 530 |
}); |
| 531 |
$finish->execute($new_version); |
| 532 |
return; |
| 533 |
} |
| 534 |
if ( $new_version > $current_version ) { |
| 535 |
my $finish = $dbh->prepare("UPDATE systempreferences SET value=? WHERE variable='Version'"); |
| 536 |
$finish->execute($new_version); |
| 537 |
} |
| 538 |
} |
| 539 |
|
| 540 |
=head2 TableExists($table) |
| 541 |
|
| 542 |
=cut |
| 543 |
|
| 544 |
sub TableExists { |
| 545 |
my $table = shift; |
| 546 |
eval { |
| 547 |
local $dbh->{PrintError} = 0; |
| 548 |
local $dbh->{RaiseError} = 0; |
| 549 |
$dbh->do(qq{SELECT * FROM $table WHERE 1 = 0 }); |
| 550 |
}; |
| 551 |
return 1 unless $@; |
| 552 |
return 0; |
| 553 |
} |
| 554 |
1; |