src/dbi.pl

   1 #
   2 #   dbi.pl: DBI (mysql/pgsql/sqlite) database frontend.
   3 #   Author: dms
   4 #  Version: v0.9a (20021124)
   5 #  Created: 19991203
   6 #    Notes: based on db_mysql.pl
   7 #           overhauled to be 31337.
   8 #
   9
  10 use strict;
  11
  12 use vars qw(%param);
  13 use vars qw($dbh $shm $bot_data_dir);
  14
  15 package main;
  16
  17 eval {
  18      # This wrapper's sole purpose in life is to keep the dbh connection open.
  19      package Bloot::DBI;
  20
  21      # These are DBI methods which do not require an active DB
  22      # connection. [Eg, don't check to see if the database is working
  23      # by pinging it for these methods.]
  24      my %no_ping;
  25      @no_ping{qw(ping err err_str quote disconnect clone)} = (1) x 6;
  26      sub new {
  27           my $class = shift;
  28           my $dbh = shift;
  29           return undef unless $dbh;
  30           $class = ref($class) if ref($class);
  31           my $self = {dbh=>$dbh};
  32           bless $self, $class;
  33           return $self;
  34      }
  35
  36      our $AUTOLOAD;
  37      sub AUTOLOAD {
  38           my $method = $AUTOLOAD;
  39           my $self = shift;
  40           die "Undefined subroutine $method called" unless defined $self;
  41           ($method) = $method =~ /([^\:]+)$/;
  42           unshift @_, $self->{dbh};
  43           return undef if not defined $self->{dbh};
  44           goto &{$self->{dbh}->can($method)} if exists $no_ping{$method} and $no_ping{$method};
  45           my $ping_count = 0;
  46           while (++$ping_count < 10){
  47                last if $self->{dbh}->ping;
  48                $self->{dbh}->disconnect;
  49                $self->{dbh} = $self->{dbh}->clone;
  50           }
  51           if ($ping_count >=10 and not $self->{dbh}->ping){
  52                &ERROR("Tried real hard but was unable to reconnect");
  53                return undef;
  54           }
  55           $_[0] = $self->{dbh};
  56           my $coderef = $self->{dbh}->can($method);
  57           goto &$coderef if defined $coderef;
  58           # Dumb DBI doesn't have a can method for some
  59           # functions. Like func.
  60           shift;
  61           return eval "\$self->{dbh}->$method(\@_)" or die $@;
  62      }
  63      1;
  64 };
  65
  66 #####
  67 # &sqlOpenDB($dbname, $dbtype, $sqluser, $sqlpass, $nofail);
  68 sub sqlOpenDB {
  69     my ($db, $type, $user, $pass, $no_fail) = @_;
  70     # this is a mess. someone fix it, please.
  71     if ($type =~ /^SQLite(2)?$/i) {
  72         $db = "dbname=$db.sqlite";
  73     } elsif ($type =~ /^pg/i) {
  74         $db = "dbname=$db";
  75         $type = 'Pg';
  76     }
  77
  78     my $dsn = "DBI:$type:$db";
  79     my $hoststr = '';
  80     # SQLHost should be unset for SQLite
  81     if (exists $param{'SQLHost'} and $param{'SQLHost'}) {
  82         # PostgreSQL requires ";" and keyword 'host'. See perldoc Pg -- troubled
  83         if ($type eq 'Pg') {
  84                 $dsn    .= ";host=$param{SQLHost}";
  85         } else {
  86                 $dsn    .= ":$param{SQLHost}";
  87         }
  88         $hoststr = " to $param{'SQLHost'}";
  89     }
  90     # SQLite ignores $user and $pass
  91     $dbh    = Bloot::DBI->new(DBI->connect($dsn, $user, $pass));
  92
  93     if ($dbh && !$dbh->err) {
  94         &status("Opened $type connection$hoststr");
  95     } else {
  96         &ERROR("Cannot connect$hoststr.");
  97         &ERROR("Since $type is not available, shutting down bot!");
  98         &ERROR( $dbh->errstr ) if ($dbh);
  99         &closePID();
 100         &closeSHM($shm);
 101         &closeLog();
 102
 103         return 0 if ($no_fail);
 104
 105         exit 1;
 106     }
 107 }
 108
 109 sub sqlCloseDB {
 110     return 0 unless ($dbh);
 111
 112     my $x = $param{SQLHost};
 113     my $hoststr = ($x) ? " to $x" : '';
 114
 115     &status("Closed DBI connection$hoststr.");
 116     $dbh->disconnect();
 117
 118     return 1;
 119 }
 120
 121 #####
 122 # Usage: &sqlQuote($str);
 123 sub sqlQuote {
 124     return $dbh->quote($_[0]);
 125 }
 126
 127 #####
 128 #  Usage: &sqlSelectMany($table, $select, [$where_href], [$other]);
 129 # Return: $sth (Statement handle object)
 130 sub sqlSelectMany {
 131     my($table, $select, $where_href, $other) = @_;
 132     my $query = "SELECT $select FROM $table";
 133     my $sth;
 134
 135     if (!defined $select or $select =~ /^\s*$/) {
 136         &WARN("sqlSelectMany: select == NULL.");
 137         return;
 138     }
 139
 140     if (!defined $table or $table =~ /^\s*$/) {
 141         &WARN("sqlSelectMany: table == NULL.");
 142         return;
 143     }
 144
 145     if ($where_href) {
 146         my $where = &hashref2where($where_href);
 147         $query .= " WHERE $where" if ($where);
 148     }
 149     $query .= " $other" if ($other);
 150
 151     if (!($sth = $dbh->prepare($query))) {
 152         &ERROR("sqlSelectMany: prepare: $DBI::errstr");
 153         return;
 154     }
 155
 156     &SQLDebug($query);
 157
 158     return if (!$sth->execute);
 159
 160     return $sth;
 161 }
 162
 163 #####
 164 #  Usage: &sqlSelect($table, $select, [$where_href, [$other]);
 165 # Return: scalar if one element, array if list of elements.
 166 #   Note: Suitable for one column returns, that is, one column in $select.
 167 #   Todo: Always return array?
 168 sub sqlSelect {
 169     my $sth     = &sqlSelectMany(@_);
 170     if (!defined $sth) {
 171         &WARN("sqlSelect failed.");
 172         return;
 173     }
 174     my @retval  = $sth->fetchrow_array;
 175     $sth->finish;
 176
 177     if (scalar @retval > 1) {
 178         return @retval;
 179     } elsif (scalar @retval == 1) {
 180         return $retval[0];
 181     } else {
 182         return;
 183     }
 184 }
 185
 186 #####
 187 #  Usage: &sqlSelectColArray($table, $select, [$where_href], [$other]);
 188 # Return: array.
 189 sub sqlSelectColArray {
 190     my $sth     = &sqlSelectMany(@_);
 191     my @retval;
 192
 193     if (!defined $sth) {
 194         &WARN("sqlSelect failed.");
 195         return;
 196     }
 197
 198     while (my @row = $sth->fetchrow_array) {
 199         push(@retval, $row[0]);
 200     }
 201     $sth->finish;
 202
 203     return @retval;
 204 }
 205
 206 #####
 207 #  Usage: &sqlSelectColHash($table, $select, [$where_href], [$other], [$type]);
 208 # Return: type = 1: $retval{ col2 }{ col1 } = 1;
 209 # Return: no  type: $retval{ col1 } = col2;
 210 #   Note: does not support $other, yet.
 211 sub sqlSelectColHash {
 212     my ($table, $select, $where_href, $other, $type) = @_;
 213     my $sth     = &sqlSelectMany($table, $select, $where_href, $other);
 214     if (!defined $sth) {
 215         &WARN("sqlSelectColhash failed.");
 216         return;
 217     }
 218     my %retval;
 219
 220     if (defined $type and $type == 2) {
 221         &DEBUG("sqlSelectColHash: type 2!");
 222         while (my @row = $sth->fetchrow_array) {
 223             $retval{$row[0]} = join(':', $row[1..$#row]);
 224         }
 225         &DEBUG("sqlSelectColHash: count => ".scalar(keys %retval) );
 226
 227     } elsif (defined $type and $type == 1) {
 228         while (my @row = $sth->fetchrow_array) {
 229             # reverse it to make it easier to count.
 230             if (scalar @row == 2) {
 231                 $retval{$row[1]}{$row[0]} = 1;
 232             } elsif (scalar @row == 3) {
 233                 $retval{$row[1]}{$row[0]} = 1;
 234             }
 235             # what to do if there's only one or more than 3?
 236         }
 237
 238     } else {
 239         while (my @row = $sth->fetchrow_array) {
 240             $retval{$row[0]} = $row[1];
 241         }
 242     }
 243
 244     $sth->finish;
 245
 246     return %retval;
 247 }
 248
 249 #####
 250 #  Usage: &sqlSelectRowHash($table, $select, [$where_href]);
 251 # Return: $hash{ col } = value;
 252 #   Note: useful for returning only one/first row of data.
 253 sub sqlSelectRowHash {
 254     my $sth     = &sqlSelectMany(@_);
 255     if (!defined $sth) {
 256         &WARN("sqlSelectRowHash failed.");
 257         return;
 258     }
 259     my $retval  = $sth->fetchrow_hashref();
 260     $sth->finish;
 261
 262     if ($retval) {
 263         return %{ $retval };
 264     } else {
 265         return;
 266     }
 267 }
 268
 269 #
 270 # End of SELECT functions.
 271 #
 272
 273 #####
 274 #  Usage: &sqlSet($table, $where_href, $data_href);
 275 # Return: 1 for success, undef for failure.
 276 sub sqlSet {
 277     my ($table, $where_href, $data_href) = @_;
 278
 279     if (!defined $table or $table =~ /^\s*$/) {
 280         &WARN("sqlSet: table == NULL.");
 281         return;
 282     }
 283
 284     if (!defined $data_href or ref($data_href) ne 'HASH') {
 285         &WARN("sqlSet: data_href == NULL.");
 286         return;
 287     }
 288
 289     # any column can be NULL... so just get them all.
 290     my $k = join(',', keys %{ $where_href } );
 291     my $result = &sqlSelect($table, $k, $where_href);
 292 #    &DEBUG("result is not defined :(") if (!defined $result);
 293
 294     # this was hardwired to use sqlUpdate. sqlite does not do inserts on sqlUpdate.
 295     if (defined $result) {
 296         &sqlUpdate($table, $data_href, $where_href);
 297     } else {
 298         # hack.
 299         my %hash = %{ $where_href };
 300         # add data_href values...
 301         foreach (keys %{ $data_href }) {
 302             $hash{ $_ } = ${ $data_href }{$_};
 303         }
 304
 305         $data_href = \%hash;
 306         &sqlInsert($table, $data_href);
 307     }
 308
 309     return 1;
 310 }
 311
 312 #####
 313 # Usage: &sqlUpdate($table, $data_href, $where_href);
 314 sub sqlUpdate {
 315     my ($table, $data_href, $where_href) = @_;
 316
 317     if (!defined $data_href or ref($data_href) ne 'HASH') {
 318         &WARN("sqlSet: data_href == NULL.");
 319         return 0;
 320     }
 321
 322     my $where  = &hashref2where($where_href) if ($where_href);
 323     my $update = &hashref2update($data_href) if ($data_href);
 324
 325     &sqlRaw('Update', "UPDATE $table SET $update WHERE $where");
 326
 327     return 1;
 328 }
 329
 330 #####
 331 # Usage: &sqlInsert($table, $data_href, $other);
 332 sub sqlInsert {
 333     my ($table, $data_href, $other) = @_;
 334     # note: if $other == 1, add 'DELAYED' to function instead.
 335     # note: ^^^ doesnt actually do anything lol. Need code to s/1/DELAYED/ below -- troubled
 336
 337     if (!defined $data_href or ref($data_href) ne 'HASH') {
 338         &WARN("sqlInsert: data_href == NULL.");
 339         return;
 340     }
 341
 342     my ($k_aref, $v_aref) = &hashref2array($data_href);
 343     my @k = @{ $k_aref };
 344     my @v = @{ $v_aref };
 345
 346     if (!@k or !@v) {
 347         &WARN("sqlInsert: keys or vals is NULL.");
 348         return;
 349     }
 350
 351     &sqlRaw("Insert($table)", sprintf(
 352         "INSERT %s INTO %s (%s) VALUES (%s)",
 353         ($other || ''), $table, join(',',@k), join(',',@v)
 354     ) );
 355
 356     return 1;
 357 }
 358
 359 #####
 360 # Usage: &sqlReplace($table, $data_href, [$pkey]);
 361 sub sqlReplace {
 362     my ($table, $data_href, $pkey) = @_;
 363
 364     if (!defined $data_href or ref($data_href) ne 'HASH') {
 365         &WARN("sqlReplace: data_href == NULL.");
 366         return;
 367     }
 368
 369     my ($k_aref, $v_aref) = &hashref2array($data_href);
 370     my @k = @{ $k_aref };
 371     my @v = @{ $v_aref };
 372
 373     if (!@k or !@v) {
 374         &WARN("sqlReplace: keys or vals is NULL.");
 375         return;
 376     }
 377
 378
 379     if ($param{'DBType'} =~ /^pgsql$/i) {
 380         # OK, heres the scoop. There is currently no REPLACE INTO in Pgsql.
 381         # However, the bot already seems to search for factoids before insert
 382         # anyways. Perhaps we could change this to a generic INSERT INTO so
 383         # we can skip the seperate sql? -- troubled to: TimRiker
 384         # PGSql syntax: UPDATE table SET key = 'value', key2 = 'value2' WHERE key = 'value'
 385
 386 #       &sqlRaw("Replace($table)", sprintf(
 387 #               "INSERT INTO %s (%s) VALUES (%s)",
 388 #               $table, join(',',@k), join(',',@v)
 389 #       ));
 390         &WARN("DEBUG: ($pkey = ) " . sprintf(
 391                 "REPLACE INTO %s (%s) VALUES (%s)",
 392                 $table, join(',',@k), join(',',@v)
 393         ));
 394
 395     } else {
 396         &sqlRaw("Replace($table)", sprintf(
 397                 "REPLACE INTO %s (%s) VALUES (%s)",
 398                 $table, join(',',@k), join(',',@v)
 399         ));
 400     }
 401
 402     return 1;
 403 }
 404
 405 #####
 406 # Usage: &sqlDelete($table, $where_href);
 407 sub sqlDelete {
 408     my ($table, $where_href) = @_;
 409
 410     if (!defined $where_href or ref($where_href) ne 'HASH') {
 411         &WARN("sqlDelete: where_href == NULL.");
 412         return;
 413     }
 414
 415     my $where   = &hashref2where($where_href);
 416
 417     &sqlRaw('Delete', "DELETE FROM $table WHERE $where");
 418
 419     return 1;
 420 }
 421
 422 #####
 423 #  Usage: &sqlRaw($prefix, $query);
 424 # Return: 1 for success, 0 for failure.
 425 sub sqlRaw {
 426     my ($prefix, $query) = @_;
 427     my $sth;
 428
 429     if (!defined $query or $query =~ /^\s*$/) {
 430         &WARN("sqlRaw: query == NULL.");
 431         return 0;
 432     }
 433
 434     if (!($sth = $dbh->prepare($query))) {
 435         &ERROR("Raw($prefix): !prepare => '$query'");
 436         return 0;
 437     }
 438
 439     &SQLDebug($query);
 440     if (!$sth->execute) {
 441         &ERROR("Raw($prefix): !execute => '$query'");
 442         $sth->finish;
 443         return 0;
 444     }
 445
 446     $sth->finish;
 447
 448     return 1;
 449 }
 450
 451 #####
 452 #  Usage: &sqlRawReturn($query);
 453 # Return: array.
 454 sub sqlRawReturn {
 455     my ($query) = @_;
 456     my @retval;
 457     my $sth;
 458
 459     if (!defined $query or $query =~ /^\s*$/) {
 460         &WARN("sqlRawReturn: query == NULL.");
 461         return 0;
 462     }
 463
 464     if (!($sth = $dbh->prepare($query))) {
 465         &ERROR("RawReturn: !prepare => '$query'");
 466         return 0;
 467     }
 468
 469     &SQLDebug($query);
 470     if (!$sth->execute) {
 471         &ERROR("RawReturn: !execute => '$query'");
 472         $sth->finish;
 473         return 0;
 474     }
 475
 476     while (my @row = $sth->fetchrow_array) {
 477         push(@retval, $row[0]);
 478     }
 479
 480     $sth->finish;
 481
 482     return @retval;
 483 }
 484
 485 ####################################################################
 486 ##### Misc DBI stuff...
 487 #####
 488
 489 sub hashref2where {
 490     my ($href) = @_;
 491
 492     if (!defined $href) {
 493         &WARN("hashref2where: href == NULL.");
 494         return;
 495     }
 496
 497     if (ref($href) ne 'HASH') {
 498         &WARN("hashref2where: href is not HASH ref (href => $href)");
 499         return;
 500     }
 501
 502     my %hash = %{ $href };
 503     foreach (keys %hash) {
 504         my $v = $hash{$_};
 505
 506         if (s/^-//) {   # as is.
 507             $hash{$_} = $v;
 508             delete $hash{'-'.$_};
 509         } else {
 510             $hash{$_} = &sqlQuote($v);
 511         }
 512     }
 513
 514     return join(' AND ', map { $_."=".$hash{$_} } keys %hash );
 515 }
 516
 517 sub hashref2update {
 518     my ($href) = @_;
 519
 520     if (ref($href) ne 'HASH') {
 521         &WARN("hashref2update: href is not HASH ref.");
 522         return;
 523     }
 524
 525     my %hash;
 526     foreach (keys %{ $href }) {
 527         my $k = $_;
 528         my $v = ${ $href }{$_};
 529
 530         # is there a better way to do this?
 531         if ($k =~ s/^-//) {   # as is.
 532             1;
 533         } else {
 534             $v = &sqlQuote($v);
 535         }
 536
 537         $hash{$k} = $v;
 538     }
 539
 540     return join(', ', map { $_."=".$hash{$_} } sort keys %hash);
 541 }
 542
 543 sub hashref2array {
 544     my ($href) = @_;
 545
 546     if (ref($href) ne 'HASH') {
 547         &WARN("hashref2update: href is not HASH ref.");
 548         return;
 549     }
 550
 551     my(@k, @v);
 552     foreach (keys %{ $href }) {
 553         my $k = $_;
 554         my $v = ${ $href }{$_};
 555
 556         # is there a better way to do this?
 557         if ($k =~ s/^-//) {   # as is.
 558             1;
 559         } else {
 560             $v = &sqlQuote($v);
 561         }
 562
 563         push(@k, $k);
 564         push(@v, $v);
 565     }
 566
 567     return (\@k, \@v);
 568 }
 569
 570 #####
 571 # Usage: &countKeys($table, [$col]);
 572 sub countKeys {
 573     my ($table, $col) = @_;
 574     $col ||= '*';
 575
 576     return (&sqlRawReturn("SELECT count($col) FROM $table"))[0];
 577 }
 578
 579 #####
 580 # Usage: &sumKey($table, $col);
 581 sub sumKey {
 582     my ($table, $col) = @_;
 583
 584     return (&sqlRawReturn("SELECT sum($col) FROM $table"))[0];
 585 }
 586
 587 #####
 588 # Usage: &randKey($table, $select);
 589 sub randKey {
 590     my ($table, $select) = @_;
 591     my $rand    = int(rand(&countKeys($table)));
 592     my $query   = "SELECT $select FROM $table LIMIT 1 OFFSET $rand";
 593     if ($param{DBType} =~ /^mysql$/i) {
 594         # WARN: only newer MySQL supports "LIMIT limit OFFSET offset"
 595         $query = "SELECT $select FROM $table LIMIT $rand,1";
 596     }
 597     my $sth     = $dbh->prepare($query);
 598     &SQLDebug($query);
 599     &WARN("randKey($query)") unless $sth->execute;
 600     my @retval  = $sth->fetchrow_array;
 601     $sth->finish;
 602
 603     return @retval;
 604 }
 605
 606 #####
 607 # Usage: &deleteTable($table);
 608 sub deleteTable {
 609     &sqlRaw("deleteTable($_[0])", "DELETE FROM $_[0]");
 610 }
 611
 612 #####
 613 # Usage: &searchTable($table, $select, $key, $str);
 614 #  Note: searchTable does sqlQuote.
 615 sub searchTable {
 616     my($table, $select, $key, $str) = @_;
 617     my $origStr = $str;
 618     my @results;
 619
 620     # allow two types of wildcards.
 621     if ($str =~ /^\^(.*)\$$/) {
 622         &FIXME("searchTable: can't do \"$str\"");
 623         $str = $1;
 624     } else {
 625         $str .= "%"     if ($str =~ s/^\^//);
 626         $str = "%".$str if ($str =~ s/\$$//);
 627         $str = "%".$str."%" if ($str eq $origStr);      # el-cheapo fix.
 628     }
 629
 630     $str =~ s/\_/\\_/g;
 631     $str =~ s/\?/_/g;   # '.' should be supported, too.
 632     $str =~ s/\*/%/g;
 633     # end of string fix.
 634
 635     my $query = "SELECT $select FROM $table WHERE $key LIKE ".
 636                 &sqlQuote($str);
 637     my $sth = $dbh->prepare($query);
 638
 639     &SQLDebug($query);
 640     if (!$sth->execute) {
 641         &WARN("Search($query)");
 642         $sth->finish;
 643         return;
 644     }
 645
 646     while (my @row = $sth->fetchrow_array) {
 647         push(@results, $row[0]);
 648     }
 649     $sth->finish;
 650
 651     return @results;
 652 }
 653
 654 sub sqlCreateTable {
 655     my($table, $dbtype) = @_;
 656     my(@path)   = ($bot_data_dir, ".","..","../..");
 657     my $found   = 0;
 658     my $data;
 659     $dbtype = lc $dbtype;
 660
 661     foreach (@path) {
 662         my $file = "$_/setup/$dbtype/$table.sql";
 663         next unless ( -f $file );
 664
 665         open(IN, $file);
 666         while (<IN>) {
 667             chop;
 668             next if $_ =~ /^--/;
 669             $data .= $_;
 670         }
 671
 672         $found++;
 673         last;
 674     }
 675
 676     if (!$found) {
 677         return 0;
 678     } else {
 679         &sqlRaw("sqlCreateTable($table)", $data);
 680         return 1;
 681     }
 682 }
 683
 684 sub checkTables {
 685     my $database_exists = 0;
 686     my %db;
 687
 688     if ($param{DBType} =~ /^mysql$/i) {
 689         my $sql = "SHOW DATABASES";
 690         foreach ( &sqlRawReturn($sql) ) {
 691             $database_exists++ if ($_ eq $param{'DBName'});
 692         }
 693
 694         unless ($database_exists) {
 695             &status("Creating database $param{DBName}...");
 696             my $query = "CREATE DATABASE $param{DBName}";
 697             &sqlRaw("create(db $param{DBName})", $query);
 698         }
 699
 700         # retrieve a list of db's from the server.
 701         my @tables = map {s/^\`//; s/\`$//; $_;} $dbh->func('_ListTables');
 702         if ($#tables == -1){
 703             @tables = $dbh->tables;
 704         }
 705         &status("Tables: ".join(',',@tables));
 706         @db{@tables} = (1) x @tables;
 707
 708     } elsif ($param{DBType} =~ /^SQLite(2)?$/i) {
 709
 710         # retrieve a list of db's from the server.
 711         foreach ( &sqlRawReturn("SELECT name FROM sqlite_master WHERE type='table'") ) {
 712             $db{$_} = 1;
 713         }
 714
 715         # create database not needed for SQLite
 716
 717     } elsif ($param{DBType} =~ /^pgsql$/i) {
 718         # $sql_showDB = SQL to select the DB list
 719         # $sql_showTBL = SQL to select all tables for the current connection
 720
 721         my $sql_showDB = "SELECT datname FROM pg_database";
 722         my $sql_showTBL = "SELECT tablename FROM pg_tables \
 723                 WHERE schemaname = 'public'";
 724
 725         foreach ( &sqlRawReturn($sql_showDB) ) {
 726                 $database_exists++ if ($_ eq $param{'DBName'});
 727         }
 728
 729         unless ($database_exists) {
 730                 &status("Creating PostgreSQL database $param{'DBName'}");
 731                 &status("(actually, not really, please read the INSTALL file)");
 732         }
 733
 734         # retrieve a list of db's from the server. This code is from mysql above, please check -- troubled
 735         my @tables = map {s/^\`//; s/\`$//; $_;} &sqlRawReturn($sql_showTBL);
 736         if ($#tables == -1){
 737             @tables = $dbh->tables;
 738         }
 739         &status("Tables: ".join(',',@tables));
 740         @db{@tables} = (1) x @tables;
 741     }
 742
 743     foreach ( qw(botmail connections factoids rootwarn seen stats onjoin) ) {
 744         if (exists $db{$_}) {
 745             $cache{has_table}{$_} = 1;
 746             next;
 747         }
 748
 749         &status("checkTables: creating new table $_...");
 750
 751         $cache{create_table}{$_} = 1;
 752
 753         &sqlCreateTable($_, $param{DBType});
 754     }
 755 }
 756
 757 1;
 758
 759 # vim:ts=4:sw=4:expandtab:tw=80