src/dbi.pl

   1 #
   2 #   dbi.pl: DBI (mysql/pgsql/sqlite) database frontend.
   3 #   Author: dms
   4 #  Version: v0.2c (19991224)
   5 #  Created: 19991203
   6 #    Notes: based on db_mysql.pl
   7 #
   8
   9 use strict;
  10
  11 use vars qw(%param);
  12 use vars qw($dbh $shm $bot_data_dir);
  13
  14 package main;
  15
  16 #####
  17 # &openDB($dbname, $dbtype, $sqluser, $sqlpass, $nofail);
  18 sub openDB {
  19     my ($db, $type, $user, $pass, $no_fail) = @_;
  20     # this is a mess. someone fix it, please.
  21     if ($type =~ /^SQLite$/i) {
  22         $db = "dbname=$db.sqlite";
  23     } elsif ($type =~ /^pg/i) {
  24         $db = "dbname=$db";
  25         $type = "Pg";
  26     }
  27
  28     my $dsn = "DBI:$type:$db";
  29     my $hoststr = "";
  30     # SQLHost should be unset for SQLite
  31     if (exists $param{'SQLHost'} and $param{'SQLHost'}) {
  32         $dsn    .= ":$param{SQLHost}";
  33         $hoststr = " to $param{'SQLHost'}";
  34     }
  35     # SQLite ignores $user and $pass
  36     $dbh    = DBI->connect($dsn, $user, $pass);
  37
  38     if ($dbh && !$dbh->err) {
  39         &status("Opened $type connection$hoststr");
  40     } else {
  41         &ERROR("cannot connect$hoststr.");
  42         &ERROR("since $type is not available, shutting down bot!");
  43         &ERROR( $dbh->errstr ) if ($dbh);
  44         &closePID();
  45         &closeSHM($shm);
  46         &closeLog();
  47
  48         return 0 if ($no_fail);
  49
  50         exit 1;
  51     }
  52 }
  53
  54 sub closeDB {
  55     return 0 unless ($dbh);
  56
  57     my $x = $param{SQLHost};
  58     my $hoststr = ($x) ? " to $x" : "";
  59
  60     &status("Closed DBI connection$hoststr.");
  61     $dbh->disconnect();
  62
  63     return 1;
  64 }
  65
  66 #####
  67 # Usage: &dbQuote($str);
  68 sub dbQuote {
  69     return $dbh->quote($_[0]);
  70 }
  71
  72 #####
  73 # Usage: &dbGet($table, $select, $where);
  74 sub dbGet {
  75     my ($table, $select, $where) = @_;
  76     my $query   = "SELECT $select FROM $table";
  77     $query      .= " WHERE $where" if ($where);
  78
  79     if (!defined $select or $select =~ /^\s*$/) {
  80         &WARN("dbGet: select == NULL.");
  81         return;
  82     }
  83
  84     if (!defined $table or $table =~ /^\s*$/) {
  85         &WARN("dbGet: table == NULL.");
  86         return;
  87     }
  88
  89     my $sth;
  90     if (!($sth = $dbh->prepare($query))) {
  91         &ERROR("Get: prepare: $DBI::errstr");
  92         return;
  93     }
  94
  95     &SQLDebug($query);
  96     if (!$sth->execute) {
  97         &ERROR("Get: execute: '$query'");
  98         $sth->finish;
  99         return 0;
 100     }
 101
 102     my @retval = $sth->fetchrow_array;
 103
 104     $sth->finish;
 105
 106     if (scalar @retval > 1) {
 107         return @retval;
 108     } elsif (scalar @retval == 1) {
 109         return $retval[0];
 110     } else {
 111         return;
 112     }
 113 }
 114
 115 #####
 116 # Usage: &dbGetCol($table, $select, $where, [$type]);
 117 sub dbGetCol {
 118     my ($table, $select, $where, $type) = @_;
 119     my $query   = "SELECT $select FROM $table";
 120     $query      .= " WHERE ".$where if ($where);
 121     my %retval;
 122
 123     my $sth = $dbh->prepare($query);
 124     &SQLDebug($query);
 125     if (!$sth->execute) {
 126         &ERROR("GetCol: execute: '$query'");
 127         $sth->finish;
 128         return;
 129     }
 130
 131     if (defined $type and $type == 2) {
 132         &DEBUG("dbgetcol: type 2!");
 133         while (my @row = $sth->fetchrow_array) {
 134             $retval{$row[0]} = join(':', $row[1..$#row]);
 135         }
 136         &DEBUG("dbgetcol: count => ".scalar(keys %retval) );
 137
 138     } elsif (defined $type and $type == 1) {
 139         while (my @row = $sth->fetchrow_array) {
 140             # reverse it to make it easier to count.
 141             if (scalar @row == 2) {
 142                 $retval{$row[1]}{$row[0]} = 1;
 143             } elsif (scalar @row == 3) {
 144                 $retval{$row[1]}{$row[0]} = 1;
 145             }
 146             # what to do if there's only one or more than 3?
 147         }
 148
 149     } else {
 150         while (my @row = $sth->fetchrow_array) {
 151             $retval{$row[0]} = $row[1];
 152         }
 153     }
 154
 155     $sth->finish;
 156
 157     return %retval;
 158 }
 159
 160 #####
 161 # Usage: &dbGetColNiceHash($table, $select, $where);
 162 sub dbGetColNiceHash {
 163     my ($table, $select, $where) = @_;
 164     $select     ||= "*";
 165     my $query   = "SELECT $select FROM $table";
 166     $query      .= " WHERE ".$where if ($where);
 167     my %retval;
 168
 169     my $sth;
 170     if (!($sth = $dbh->prepare($query))) {
 171         &ERROR("GetColNiceHash: prepare: $DBI::errstr");
 172         return;
 173     }
 174     &SQLDebug($query);
 175     if (!$sth->execute) {
 176         &ERROR("GetColNiceHash: execute: '$query'");
 177 #       &ERROR("GetCol => $DBI::errstr");
 178         $sth->finish;
 179         return;
 180     }
 181
 182     my $retval = $sth->fetchrow_hashref();
 183
 184     $sth->finish;
 185
 186     if ($retval) {
 187         return %{$retval};
 188     } else {
 189         return;
 190     }
 191 }
 192
 193 ####
 194 # Usage: &dbGetColInfo($table);
 195 sub dbGetColInfo {
 196     my ($table) = @_;
 197
 198     my $query = "SHOW COLUMNS from $table";
 199     if ($param{DBType} =~ /^pg/i) {
 200         $query = "SELECT * FROM $table LIMIT 1";
 201     }
 202
 203     my %retval;
 204
 205     my $sth = $dbh->prepare($query);
 206     &SQLDebug($query);
 207     if (!$sth->execute) {
 208         &ERROR("GRI => '$query'");
 209         &ERROR("GRI => $DBI::errstr");
 210         $sth->finish;
 211         return;
 212     }
 213
 214     my @cols;
 215     while (my @row = $sth->fetchrow_array) {
 216         push(@cols, $row[0]);
 217     }
 218     $sth->finish;
 219
 220     return @cols;
 221 }
 222
 223 ##### NOTE: not used yet.
 224 # Usage: &dbSelectHashref($select, $from, $where, $other)
 225 sub dbSelectHashref {
 226     my $c = dbSelectManyHash(@_);
 227     my $H = $c->fetchrow_hashref;
 228     $c->finish;
 229     return $H;
 230 }
 231
 232 ##### NOTE: not used yet.
 233 # Usage: &dbSelectHashref($select, $from, $where, $other)
 234 sub dbSelectManyHash {
 235     my($select, $from, $where, $other) = @_;
 236     my $sql;
 237
 238     $sql = "SELECT $select ";
 239     $sql .= "FROM $from "       if $from;
 240     $sql .= "WHERE $where "     if $where;
 241     $sql .= "$other"            if $other;
 242
 243 #    sqlConnect();
 244     my $c = $dbh->prepare($sql);
 245     # $c->execute or print "\n<P><B>SQL Hashref Error</B><BR>\n";
 246
 247     unless ($c->execute) {
 248 #       apacheLog($sql);
 249         #kill 9,$$;
 250     }
 251
 252     return $c;
 253 }
 254
 255
 256 #####
 257 # Usage: &dbSet($table, $primhash_ref, $hash_ref);
 258 #  Note: dbSet does dbQuote.
 259 sub dbSet {
 260     my ($table, $phref, $href) = @_;
 261     my $where = join(' AND ', map {
 262                 $_."=".&dbQuote($phref->{$_})
 263         } keys %{$phref}
 264     );
 265
 266     if (!defined $phref) {
 267         &WARN("dbset: phref == NULL.");
 268         return;
 269     }
 270
 271     if (!defined $href) {
 272         &WARN("dbset: href == NULL.");
 273         return;
 274     }
 275
 276     if (!defined $table) {
 277         &WARN("dbset: table == NULL.");
 278         return;
 279     }
 280
 281     my(@keys,@vals);
 282     foreach (keys %{$href}) {
 283         push(@keys, $_);
 284         push(@vals, &dbQuote($href->{$_}) );
 285     }
 286
 287     if (!@keys or !@vals) {
 288         &WARN("dbset: keys or vals is NULL.");
 289         return;
 290     }
 291
 292     my $result = &dbGet($table, join(',', keys %{$phref}), $where);
 293
 294     my $query;
 295     if (defined $result) {
 296         my @keyval;
 297         for(my$i=0; $i<scalar @keys; $i++) {
 298             push(@keyval, $keys[$i]."=".$vals[$i] );
 299         }
 300
 301         $query = "UPDATE $table SET ".
 302                 join(', ', @keyval).
 303                 " WHERE ".$where;
 304     } else {
 305         foreach (keys %{$phref}) {
 306             push(@keys, $_);
 307             push(@vals, &dbQuote($phref->{$_}) );
 308         }
 309
 310         $query = sprintf("INSERT INTO $table (%s) VALUES (%s)",
 311                 join(',',@keys), join(',',@vals) );
 312     }
 313
 314     &dbRaw("Set", $query);
 315
 316     return 1;
 317 }
 318
 319 #####
 320 # Usage: &dbUpdate($table, $primkey, $primval, %hash);
 321 #  Note: dbUpdate does dbQuote.
 322 sub dbUpdate {
 323     my ($table, $primkey, $primval, %hash) = @_;
 324     my (@array);
 325
 326     foreach (keys %hash) {
 327         push(@array, "$_=".&dbQuote($hash{$_}) );
 328     }
 329
 330     &dbRaw("Update", "UPDATE $table SET ".join(', ', @array).
 331                 " WHERE $primkey=".&dbQuote($primval)
 332     );
 333
 334     return 1;
 335 }
 336
 337 #####
 338 # Usage: &dbInsert($table, $primkey, %hash);
 339 #  Note: dbInsert does dbQuote.
 340 sub dbInsert {
 341     my ($table, $primkey, %hash, $delay) = @_;
 342     my (@keys, @vals);
 343     my $p       = "";
 344
 345     if ($delay) {
 346         &DEBUG("dbI: delay => $delay");
 347         $p      = " DELAYED";
 348     }
 349
 350     foreach (keys %hash) {
 351         push(@keys, $_);
 352         push(@vals, &dbQuote( $hash{$_} ));
 353     }
 354
 355     &dbRaw("Insert($table)", "INSERT $p INTO $table (".join(',',@keys).
 356                 ") VALUES (".join(',',@vals).")"
 357     );
 358
 359     return 1;
 360 }
 361
 362 #####
 363 # Usage: &dbReplace($table, $key, %hash);
 364 #  Note: dbReplace does optional dbQuote.
 365 sub dbReplace {
 366     my ($table, $key, %hash) = @_;
 367     my (@keys, @vals);
 368
 369     foreach (keys %hash) {
 370         if (s/^-//) {   # as is.
 371             push(@keys, $_);
 372             push(@vals, $hash{'-'.$_});
 373         } else {
 374             push(@keys, $_);
 375             push(@vals, &dbQuote( $hash{$_} ));
 376         }
 377     }
 378
 379     # hrm... does pgsql support REPLACE?
 380     # if not, well... fuck it.
 381     &dbRaw("Replace($table)", "REPLACE INTO $table (".join(',',@keys).
 382                 ") VALUES (". join(',',@vals). ")"
 383     );
 384
 385     return 1;
 386 }
 387
 388 #####
 389 # Usage: &dbSetRow($table, $vref, $delay);
 390 #  Note: dbSetRow does dbQuote.
 391 sub dbSetRow ($@$) {
 392     my ($table, $vref, $delay) = @_;
 393     my $p       = ($delay) ? " DELAYED " : "";
 394
 395     # see 'perldoc perlreftut'
 396     my @values;
 397     foreach (@{ $vref }) {
 398         push(@values, &dbQuote($_) );
 399     }
 400
 401     if (!scalar @values) {
 402         &WARN("dbSetRow: values array == NULL.");
 403         return;
 404     }
 405
 406     return &dbRaw("SetRow", "INSERT $p INTO $table VALUES (".
 407         join(",", @values) .")" );
 408 }
 409
 410 #####
 411 # Usage: &dbDel($table, $primkey, $primval, [$key]);
 412 #  Note: dbDel does dbQuote
 413 sub dbDel {
 414     my ($table, $primkey, $primval, $key) = @_;
 415
 416     &dbRaw("Del", "DELETE FROM $table WHERE $primkey=".
 417                 &dbQuote($primval)
 418     );
 419
 420     return 1;
 421 }
 422
 423 # Usage: &dbRaw($prefix,$rawquery);
 424 sub dbRaw {
 425     my ($prefix,$query) = @_;
 426     my $sth;
 427
 428     if (!($sth = $dbh->prepare($query))) {
 429         &ERROR("Raw($prefix): !prepare => '$query'");
 430         return 0;
 431     }
 432
 433     &SQLDebug($query);
 434     if (!$sth->execute) {
 435         &ERROR("Raw($prefix): !execute => '$query'");
 436         $sth->finish;
 437         return 0;
 438     }
 439
 440     $sth->finish;
 441
 442     return 1;
 443 }
 444
 445 # Usage: &dbRawReturn($rawquery);
 446 sub dbRawReturn {
 447     my ($query) = @_;
 448     my @retval;
 449
 450     my $sth = $dbh->prepare($query);
 451     &SQLDebug($query);
 452     # what happens when it can't execute it? does it throw heaps more
 453     # error lines? if so. follow dbRaw()'s style.
 454     &ERROR("RawReturn => '$query'.") unless $sth->execute;
 455     while (my @row = $sth->fetchrow_array) {
 456         push(@retval, $row[0]);
 457     }
 458     $sth->finish;
 459
 460     return @retval;
 461 }
 462
 463 ####################################################################
 464 ##### Misc DBI stuff...
 465 #####
 466
 467 #####
 468 # Usage: &countKeys($table, [$col]);
 469 sub countKeys {
 470     my ($table, $col) = @_;
 471     $col ||= "*";
 472     &DEBUG("&countKeys($table, $col);");
 473
 474     return (&dbRawReturn("SELECT count($col) FROM $table"))[0];
 475 }
 476
 477 #####
 478 # Usage: &sumKey($table, $col);
 479 sub sumKey {
 480     my ($table, $col) = @_;
 481
 482     return (&dbRawReturn("SELECT sum($col) FROM $table"))[0];
 483 }
 484
 485 #####
 486 # Usage: &randKey($table, $select);
 487 sub randKey {
 488     my ($table, $select) = @_;
 489     my $rand    = int(rand(&countKeys($table) - 1));
 490     my $query   = "SELECT $select FROM $table LIMIT $rand,1";
 491     if ($param{DBType} =~ /^pg/i) {
 492         $query =~ s/$rand,1/1,$rand/;
 493     }
 494
 495     my $sth     = $dbh->prepare($query);
 496     &SQLDebug($query);
 497     &WARN("randKey($query)") unless $sth->execute;
 498     my @retval  = $sth->fetchrow_array;
 499     $sth->finish;
 500
 501     return @retval;
 502 }
 503
 504 #####
 505 # Usage: &deleteTable($table);
 506 sub deleteTable {
 507     &dbRaw("deleteTable($_[0])", "DELETE FROM $_[0]");
 508 }
 509
 510 #####
 511 # Usage: &searchTable($table, $select, $key, $str);
 512 #  Note: searchTable does dbQuote.
 513 sub searchTable {
 514     my($table, $select, $key, $str) = @_;
 515     my $origStr = $str;
 516     my @results;
 517
 518     # allow two types of wildcards.
 519     if ($str =~ /^\^(.*)\$$/) {
 520         &DEBUG("searchTable: should use dbGet(), heh.");
 521         $str = $1;
 522     } else {
 523         $str .= "%"     if ($str =~ s/^\^//);
 524         $str = "%".$str if ($str =~ s/\$$//);
 525         $str = "%".$str."%" if ($str eq $origStr);      # el-cheapo fix.
 526     }
 527
 528     $str =~ s/\_/\\_/g;
 529     $str =~ s/\?/_/g;   # '.' should be supported, too.
 530     $str =~ s/\*/%/g;
 531     # end of string fix.
 532
 533     my $query = "SELECT $select FROM $table WHERE $key LIKE ".
 534                 &dbQuote($str);
 535     my $sth = $dbh->prepare($query);
 536
 537     &SQLDebug($query);
 538     if (!$sth->execute) {
 539         &WARN("Search($query)");
 540         $sth->finish;
 541         return;
 542     }
 543
 544     while (my @row = $sth->fetchrow_array) {
 545         push(@results, $row[0]);
 546     }
 547     $sth->finish;
 548
 549     return @results;
 550 }
 551
 552 sub dbCreateTable {
 553     my($table)  = @_;
 554     my(@path)   = ($bot_data_dir, ".","..","../..");
 555     my $found   = 0;
 556     my $data;
 557
 558     foreach (@path) {
 559         my $file = "$_/setup/$table.sql";
 560         &DEBUG("dbCT: table => '$table', file => '$file'");
 561         next unless ( -f $file );
 562
 563         &DEBUG("dbCT: found!!!");
 564
 565         open(IN, $file);
 566         while (<IN>) {
 567             chop;
 568             $data .= $_;
 569         }
 570
 571         $found++;
 572         last;
 573     }
 574
 575     if (!$found) {
 576         return 0;
 577     } else {
 578         &dbRaw("dbcreateTable($table)", $data);
 579         return 1;
 580     }
 581 }
 582
 583 sub checkTables {
 584     my $database_exists = 0;
 585     my %db;
 586
 587     if ($param{DBType} =~ /^mysql$/i) {
 588         my $sql = "SHOW DATABASES";
 589         foreach ( &dbRawReturn($sql) ) {
 590             $database_exists++ if ($_ eq $param{'DBName'});
 591         }
 592
 593         unless ($database_exists) {
 594             &status("Creating database $param{DBName}...");
 595             my $query = "CREATE DATABASE $param{DBName}";
 596             &dbRaw("create(db $param{DBName})", $query);
 597         }
 598
 599         # retrieve a list of db's from the server.
 600         foreach ($dbh->func('_ListTables')) {
 601             $db{$_} = 1;
 602         }
 603
 604     } elsif ($param{DBType} =~ /^SQLite$/i) {
 605
 606         # retrieve a list of db's from the server.
 607         foreach ( &dbRawReturn("SELECT name FROM sqlite_master WHERE type='table'") ) {
 608             $db{$_} = 1;
 609         }
 610
 611         # create database.
 612         if (!scalar keys %db) {
 613             &status("Creating database $param{'DBName'}...");
 614             my $query = "CREATE DATABASE $param{'DBName'}";
 615             &dbRaw("create(db $param{'DBName'})", $query);
 616         }
 617     }
 618
 619     foreach ( qw(factoids freshmeat rootwarn seen stats botmail) ) {
 620         next if (exists $db{$_});
 621         &status("checkTables: creating new table $_...");
 622
 623         &dbCreateTable($_);
 624     }
 625 }
 626
 627 1;