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