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