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 = $dbh->prepare($query);
 170     &SQLDebug($query);
 171     if (!$sth->execute) {
 172         &ERROR("GetColNiceHash: execute: '$query'");
 173 #       &ERROR("GetCol => $DBI::errstr");
 174         $sth->finish;
 175         return;
 176     }
 177
 178     %retval = %{ $sth->fetchrow_hashref() };
 179
 180     $sth->finish;
 181
 182     return %retval;
 183 }
 184
 185 ####
 186 # Usage: &dbGetColInfo($table);
 187 sub dbGetColInfo {
 188     my ($table) = @_;
 189
 190     my $query = "SHOW COLUMNS from $table";
 191     if ($param{DBType} =~ /^pg/i) {
 192         $query = "SELECT * FROM $table LIMIT 1";
 193     }
 194
 195     my %retval;
 196
 197     my $sth = $dbh->prepare($query);
 198     &SQLDebug($query);
 199     if (!$sth->execute) {
 200         &ERROR("GRI => '$query'");
 201         &ERROR("GRI => $DBI::errstr");
 202         $sth->finish;
 203         return;
 204     }
 205
 206     my @cols;
 207     while (my @row = $sth->fetchrow_array) {
 208         push(@cols, $row[0]);
 209     }
 210     $sth->finish;
 211
 212     return @cols;
 213 }
 214
 215 ##### NOTE: not used yet.
 216 # Usage: &dbSelectHashref($select, $from, $where, $other)
 217 sub dbSelectHashref {
 218     my $c = dbSelectManyHash(@_);
 219     my $H = $c->fetchrow_hashref;
 220     $c->finish;
 221     return $H;
 222 }
 223
 224 ##### NOTE: not used yet.
 225 # Usage: &dbSelectHashref($select, $from, $where, $other)
 226 sub dbSelectManyHash {
 227     my($select, $from, $where, $other) = @_;
 228     my $sql;
 229
 230     $sql = "SELECT $select ";
 231     $sql .= "FROM $from "       if $from;
 232     $sql .= "WHERE $where "     if $where;
 233     $sql .= "$other"            if $other;
 234
 235 #    sqlConnect();
 236     my $c = $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(', ', @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;