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