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