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     return &sqlRaw("Insert($table)", sprintf(
 297         "INSERT %s INTO %s (%s) VALUES (%s)",
 298         ($other || ""), $table, join(',',@k), join(',',@v)
 299     ) );
 300 }
 301
 302 #####
 303 # Usage: &sqlReplace($table, $data_href);
 304 sub sqlReplace {
 305     my ($table, $data_href) = @_;
 306
 307     if (!defined $data_href or ref($data_href) ne "HASH") {
 308         &WARN("sqlReplace: data_href == NULL.");
 309         return;
 310     }
 311
 312     my ($k_aref, $v_aref) = &hashref2array($data_href);
 313     my @k = @{ $k_aref };
 314     my @v = @{ $v_aref };
 315
 316     if (!@k or !@v) {
 317         &WARN("sqlReplace: keys or vals is NULL.");
 318         return;
 319     }
 320
 321     &sqlRaw("Replace($table)", sprintf(
 322         "REPLACE INTO %s (%s) VALUES (%s)",
 323         $table, join(',',@k), join(',',@v)
 324     ) );
 325
 326     return 1;
 327 }
 328
 329 #####
 330 # Usage: &sqlDelete($table, $where_href);
 331 sub sqlDelete {
 332     my ($table, $where_href) = @_;
 333
 334     if (!defined $where_href or ref($where_href) ne "HASH") {
 335         &WARN("sqlDelete: where_href == NULL.");
 336         return;
 337     }
 338
 339     my $where   = &hashref2where($where_href);
 340
 341     &sqlRaw("Delete", "DELETE FROM $table WHERE $where");
 342
 343     return 1;
 344 }
 345
 346 #####
 347 #  Usage: &sqlRaw($prefix, $query);
 348 # Return: 1 for success, 0 for failure.
 349 sub sqlRaw {
 350     my ($prefix, $query) = @_;
 351     my $sth;
 352
 353     if (!defined $query or $query =~ /^\s*$/) {
 354         &WARN("sqlRaw: query == NULL.");
 355         return 0;
 356     }
 357
 358     if (!($sth = $dbh->prepare($query))) {
 359         &ERROR("Raw($prefix): !prepare => '$query'");
 360         return 0;
 361     }
 362
 363     &SQLDebug($query);
 364     if (!$sth->execute) {
 365         &ERROR("Raw($prefix): !execute => '$query'");
 366         $sth->finish;
 367         return 0;
 368     }
 369
 370     $sth->finish;
 371
 372     return 1;
 373 }
 374
 375 #####
 376 #  Usage: &sqlRawReturn($query);
 377 # Return: array.
 378 sub sqlRawReturn {
 379     my ($query) = @_;
 380     my @retval;
 381     my $sth;
 382
 383     if (!defined $query or $query =~ /^\s*$/) {
 384         &WARN("sqlRawReturn: query == NULL.");
 385         return 0;
 386     }
 387
 388     if (!($sth = $dbh->prepare($query))) {
 389         &ERROR("RawReturn: !prepare => '$query'");
 390         return 0;
 391     }
 392
 393     &SQLDebug($query);
 394     if (!$sth->execute) {
 395         &ERROR("RawReturn: !execute => '$query'");
 396         $sth->finish;
 397         return 0;
 398     }
 399
 400     while (my @row = $sth->fetchrow_array) {
 401         push(@retval, $row[0]);
 402     }
 403
 404     $sth->finish;
 405
 406     return @retval;
 407 }
 408
 409 ####################################################################
 410 ##### Misc DBI stuff...
 411 #####
 412
 413 sub hashref2where {
 414     my ($href) = @_;
 415
 416     if (!defined $href) {
 417         &WARN("hashref2where: href == NULL.");
 418         return;
 419     }
 420
 421     if (ref($href) ne "HASH") {
 422         &WARN("hashref2where: href is not HASH ref (href => $href)");
 423         return;
 424     }
 425
 426     my %hash = %{ $href };
 427     foreach (keys %hash) {
 428         my $v = $hash{$_};
 429
 430         if (s/^-//) {   # as is.
 431             $hash{$_} = $v;
 432             delete $hash{'-'.$_};
 433         } else {
 434             $hash{$_} = &sqlQuote($v);
 435         }
 436     }
 437
 438     return join(' AND ', map { $_."=".$hash{$_} } keys %hash );
 439 }
 440
 441 sub hashref2update {
 442     my ($href) = @_;
 443
 444     if (ref($href) ne "HASH") {
 445         &WARN("hashref2update: href is not HASH ref.");
 446         return;
 447     }
 448
 449     my %hash;
 450     foreach (keys %{ $href }) {
 451         my $k = $_;
 452         my $v = ${ $href }{$_};
 453
 454         # is there a better way to do this?
 455         if ($k =~ s/^-//) {   # as is.
 456             1;
 457         } else {
 458             $v = &sqlQuote($v);
 459         }
 460
 461         $hash{$k} = $v;
 462     }
 463
 464     return join(', ', map { $_."=".$hash{$_} } sort keys %hash);
 465 }
 466
 467 sub hashref2array {
 468     my ($href) = @_;
 469
 470     if (ref($href) ne "HASH") {
 471         &WARN("hashref2update: href is not HASH ref.");
 472         return;
 473     }
 474
 475     my(@k, @v);
 476     foreach (keys %{ $href }) {
 477         my $k = $_;
 478         my $v = ${ $href }{$_};
 479
 480         # is there a better way to do this?
 481         if ($k =~ s/^-//) {   # as is.
 482             1;
 483         } else {
 484             $v = &sqlQuote($v);
 485         }
 486
 487         push(@k, $k);
 488         push(@v, $v);
 489     }
 490
 491     return (\@k, \@v);
 492 }
 493
 494 #####
 495 # Usage: &countKeys($table, [$col]);
 496 sub countKeys {
 497     my ($table, $col) = @_;
 498     $col ||= "*";
 499
 500     return (&sqlRawReturn("SELECT count($col) FROM $table"))[0];
 501 }
 502
 503 #####
 504 # Usage: &sumKey($table, $col);
 505 sub sumKey {
 506     my ($table, $col) = @_;
 507
 508     return (&sqlRawReturn("SELECT sum($col) FROM $table"))[0];
 509 }
 510
 511 #####
 512 # Usage: &randKey($table, $select);
 513 sub randKey {
 514     my ($table, $select) = @_;
 515     my $rand    = int(rand(&countKeys($table)));
 516     my $query   = "SELECT $select FROM $table LIMIT 1 OFFSET $rand";
 517     if ($param{DBType} =~ /^mysql$/i) {
 518         # WARN: only newer MySQL supports "LIMIT limit OFFSET offset"
 519         $query = "SELECT $select FROM $table LIMIT $rand,1";
 520     }
 521     my $sth     = $dbh->prepare($query);
 522     &SQLDebug($query);
 523     &WARN("randKey($query)") unless $sth->execute;
 524     my @retval  = $sth->fetchrow_array;
 525     $sth->finish;
 526
 527     return @retval;
 528 }
 529
 530 #####
 531 # Usage: &deleteTable($table);
 532 sub deleteTable {
 533     &sqlRaw("deleteTable($_[0])", "DELETE FROM $_[0]");
 534 }
 535
 536 #####
 537 # Usage: &searchTable($table, $select, $key, $str);
 538 #  Note: searchTable does sqlQuote.
 539 sub searchTable {
 540     my($table, $select, $key, $str) = @_;
 541     my $origStr = $str;
 542     my @results;
 543
 544     # allow two types of wildcards.
 545     if ($str =~ /^\^(.*)\$$/) {
 546         &FIXME("searchTable: can't do \"$str\"");
 547         $str = $1;
 548     } else {
 549         $str .= "%"     if ($str =~ s/^\^//);
 550         $str = "%".$str if ($str =~ s/\$$//);
 551         $str = "%".$str."%" if ($str eq $origStr);      # el-cheapo fix.
 552     }
 553
 554     $str =~ s/\_/\\_/g;
 555     $str =~ s/\?/_/g;   # '.' should be supported, too.
 556     $str =~ s/\*/%/g;
 557     # end of string fix.
 558
 559     my $query = "SELECT $select FROM $table WHERE $key LIKE ".
 560                 &sqlQuote($str);
 561     my $sth = $dbh->prepare($query);
 562
 563     &SQLDebug($query);
 564     if (!$sth->execute) {
 565         &WARN("Search($query)");
 566         $sth->finish;
 567         return;
 568     }
 569
 570     while (my @row = $sth->fetchrow_array) {
 571         push(@results, $row[0]);
 572     }
 573     $sth->finish;
 574
 575     return @results;
 576 }
 577
 578 sub sqlCreateTable {
 579     my($table)  = @_;
 580     my(@path)   = ($bot_data_dir, ".","..","../..");
 581     my $found   = 0;
 582     my $data;
 583
 584     foreach (@path) {
 585         my $file = "$_/setup/$table.sql";
 586         next unless ( -f $file );
 587
 588         open(IN, $file);
 589         while (<IN>) {
 590             chop;
 591             $data .= $_;
 592         }
 593
 594         $found++;
 595         last;
 596     }
 597
 598     if (!$found) {
 599         return 0;
 600     } else {
 601         &sqlRaw("sqlCreateTable($table)", $data);
 602         return 1;
 603     }
 604 }
 605
 606 sub checkTables {
 607     my $database_exists = 0;
 608     my %db;
 609
 610     if ($param{DBType} =~ /^mysql$/i) {
 611         my $sql = "SHOW DATABASES";
 612         foreach ( &sqlRawReturn($sql) ) {
 613             $database_exists++ if ($_ eq $param{'DBName'});
 614         }
 615
 616         unless ($database_exists) {
 617             &status("Creating database $param{DBName}...");
 618             my $query = "CREATE DATABASE $param{DBName}";
 619             &sqlRaw("create(db $param{DBName})", $query);
 620         }
 621
 622         # retrieve a list of db's from the server.
 623         my @tables = map {s/^\`//; s/\`$//; $_;} $dbh->func('_ListTables');
 624         if ($#tables == -1){
 625             @tables = $dbh->tables;
 626         }
 627         &status("Tables: ".join(',',@tables));
 628         @db{@tables} = (1) x @tables;
 629
 630     } elsif ($param{DBType} =~ /^SQLite(2)?$/i) {
 631
 632         # retrieve a list of db's from the server.
 633         foreach ( &sqlRawReturn("SELECT name FROM sqlite_master WHERE type='table'") ) {
 634             $db{$_} = 1;
 635         }
 636
 637         # create database not needed for SQLite
 638     }
 639
 640     foreach ( qw(botmail connections factoids rootwarn seen stats onjoin) ) {
 641         if (exists $db{$_}) {
 642             $cache{has_table}{$_} = 1;
 643             next;
 644         }
 645
 646         &status("checkTables: creating new table $_...");
 647
 648         $cache{create_table}{$_} = 1;
 649
 650         &sqlCreateTable($_);
 651     }
 652 }
 653
 654 1;