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