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