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