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