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