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     # FIXME this dies hard if there are no results
 183     %retval = %{ $sth->fetchrow_hashref };
 184
 185     $sth->finish;
 186
 187     return %retval;
 188 }
 189
 190 ####
 191 # Usage: &dbGetColInfo($table);
 192 sub dbGetColInfo {
 193     my ($table) = @_;
 194
 195     my $query = "SHOW COLUMNS from $table";
 196     if ($param{DBType} =~ /^pg/i) {
 197         $query = "SELECT * FROM $table LIMIT 1";
 198     }
 199
 200     my %retval;
 201
 202     my $sth = $dbh->prepare($query);
 203     &SQLDebug($query);
 204     if (!$sth->execute) {
 205         &ERROR("GRI => '$query'");
 206         &ERROR("GRI => $DBI::errstr");
 207         $sth->finish;
 208         return;
 209     }
 210
 211     my @cols;
 212     while (my @row = $sth->fetchrow_array) {
 213         push(@cols, $row[0]);
 214     }
 215     $sth->finish;
 216
 217     return @cols;
 218 }
 219
 220 ##### NOTE: not used yet.
 221 # Usage: &dbSelectHashref($select, $from, $where, $other)
 222 sub dbSelectHashref {
 223     my $c = dbSelectManyHash(@_);
 224     my $H = $c->fetchrow_hashref;
 225     $c->finish;
 226     return $H;
 227 }
 228
 229 ##### NOTE: not used yet.
 230 # Usage: &dbSelectHashref($select, $from, $where, $other)
 231 sub dbSelectManyHash {
 232     my($select, $from, $where, $other) = @_;
 233     my $sql;
 234
 235     $sql = "SELECT $select ";
 236     $sql .= "FROM $from "       if $from;
 237     $sql .= "WHERE $where "     if $where;
 238     $sql .= "$other"            if $other;
 239
 240 #    sqlConnect();
 241     my $c = $dbh->prepare($sql);
 242     # $c->execute or print "\n<P><B>SQL Hashref Error</B><BR>\n";
 243
 244     unless ($c->execute) {
 245 #       apacheLog($sql);
 246         #kill 9,$$;
 247     }
 248
 249     return $c;
 250 }
 251
 252
 253 #####
 254 # Usage: &dbSet($table, $primhash_ref, $hash_ref);
 255 #  Note: dbSet does dbQuote.
 256 sub dbSet {
 257     my ($table, $phref, $href) = @_;
 258     my $where = join(' AND ', map {
 259                 $_."=".&dbQuote($phref->{$_})
 260         } keys %{$phref}
 261     );
 262
 263     if (!defined $phref) {
 264         &WARN("dbset: phref == NULL.");
 265         return;
 266     }
 267
 268     if (!defined $href) {
 269         &WARN("dbset: href == NULL.");
 270         return;
 271     }
 272
 273     if (!defined $table) {
 274         &WARN("dbset: table == NULL.");
 275         return;
 276     }
 277
 278     my(@keys,@vals);
 279     foreach (keys %{$href}) {
 280         push(@keys, $_);
 281         push(@vals, &dbQuote($href->{$_}) );
 282     }
 283
 284     if (!@keys or !@vals) {
 285         &WARN("dbset: keys or vals is NULL.");
 286         return;
 287     }
 288
 289     my $result = &dbGet($table, join(',', keys %{$phref}), $where);
 290
 291     my $query;
 292     if (defined $result) {
 293         my @keyval;
 294         for(my$i=0; $i<scalar @keys; $i++) {
 295             push(@keyval, $keys[$i]."=".$vals[$i] );
 296         }
 297
 298         $query = "UPDATE $table SET ".
 299                 join(', ', @keyval).
 300                 " WHERE ".$where;
 301     } else {
 302         foreach (keys %{$phref}) {
 303             push(@keys, $_);
 304             push(@vals, &dbQuote($phref->{$_}) );
 305         }
 306
 307         $query = sprintf("INSERT INTO $table (%s) VALUES (%s)",
 308                 join(',',@keys), join(',',@vals) );
 309     }
 310
 311     &dbRaw("Set", $query);
 312
 313     return 1;
 314 }
 315
 316 #####
 317 # Usage: &dbUpdate($table, $primkey, $primval, %hash);
 318 #  Note: dbUpdate does dbQuote.
 319 sub dbUpdate {
 320     my ($table, $primkey, $primval, %hash) = @_;
 321     my (@array);
 322
 323     foreach (keys %hash) {
 324         push(@array, "$_=".&dbQuote($hash{$_}) );
 325     }
 326
 327     &dbRaw("Update", "UPDATE $table SET ".join(', ', @array).
 328                 " WHERE $primkey=".&dbQuote($primval)
 329     );
 330
 331     return 1;
 332 }
 333
 334 #####
 335 # Usage: &dbInsert($table, $primkey, %hash);
 336 #  Note: dbInsert does dbQuote.
 337 sub dbInsert {
 338     my ($table, $primkey, %hash, $delay) = @_;
 339     my (@keys, @vals);
 340     my $p       = "";
 341
 342     if ($delay) {
 343         &DEBUG("dbI: delay => $delay");
 344         $p      = " DELAYED";
 345     }
 346
 347     foreach (keys %hash) {
 348         push(@keys, $_);
 349         push(@vals, &dbQuote( $hash{$_} ));
 350     }
 351
 352     &dbRaw("Insert($table)", "INSERT $p INTO $table (".join(',',@keys).
 353                 ") VALUES (".join(',',@vals).")"
 354     );
 355
 356     return 1;
 357 }
 358
 359 #####
 360 # Usage: &dbReplace($table, $key, %hash);
 361 #  Note: dbReplace does optional dbQuote.
 362 sub dbReplace {
 363     my ($table, $key, %hash) = @_;
 364     my (@keys, @vals);
 365
 366     foreach (keys %hash) {
 367         if (s/^-//) {   # as is.
 368             push(@keys, $_);
 369             push(@vals, $hash{'-'.$_});
 370         } else {
 371             push(@keys, $_);
 372             push(@vals, &dbQuote( $hash{$_} ));
 373         }
 374     }
 375
 376     # hrm... does pgsql support REPLACE?
 377     # if not, well... fuck it.
 378     &dbRaw("Replace($table)", "REPLACE INTO $table (".join(',',@keys).
 379                 ") VALUES (". join(',',@vals). ")"
 380     );
 381
 382     return 1;
 383 }
 384
 385 #####
 386 # Usage: &dbSetRow($table, $vref, $delay);
 387 #  Note: dbSetRow does dbQuote.
 388 sub dbSetRow ($@$) {
 389     my ($table, $vref, $delay) = @_;
 390     my $p       = ($delay) ? " DELAYED " : "";
 391
 392     # see 'perldoc perlreftut'
 393     my @values;
 394     foreach (@{ $vref }) {
 395         push(@values, &dbQuote($_) );
 396     }
 397
 398     if (!scalar @values) {
 399         &WARN("dbSetRow: values array == NULL.");
 400         return;
 401     }
 402
 403     return &dbRaw("SetRow", "INSERT $p INTO $table VALUES (".
 404         join(",", @values) .")" );
 405 }
 406
 407 #####
 408 # Usage: &dbDel($table, $primkey, $primval, [$key]);
 409 #  Note: dbDel does dbQuote
 410 sub dbDel {
 411     my ($table, $primkey, $primval, $key) = @_;
 412
 413     &dbRaw("Del", "DELETE FROM $table WHERE $primkey=".
 414                 &dbQuote($primval)
 415     );
 416
 417     return 1;
 418 }
 419
 420 # Usage: &dbRaw($prefix,$rawquery);
 421 sub dbRaw {
 422     my ($prefix,$query) = @_;
 423     my $sth;
 424
 425     if (!($sth = $dbh->prepare($query))) {
 426         &ERROR("Raw($prefix): !prepare => '$query'");
 427         return 0;
 428     }
 429
 430     &SQLDebug($query);
 431     if (!$sth->execute) {
 432         &ERROR("Raw($prefix): !execute => '$query'");
 433         $sth->finish;
 434         return 0;
 435     }
 436
 437     $sth->finish;
 438
 439     return 1;
 440 }
 441
 442 # Usage: &dbRawReturn($rawquery);
 443 sub dbRawReturn {
 444     my ($query) = @_;
 445     my @retval;
 446
 447     my $sth = $dbh->prepare($query);
 448     &SQLDebug($query);
 449     # what happens when it can't execute it? does it throw heaps more
 450     # error lines? if so. follow dbRaw()'s style.
 451     &ERROR("RawReturn => '$query'.") unless $sth->execute;
 452     while (my @row = $sth->fetchrow_array) {
 453         push(@retval, $row[0]);
 454     }
 455     $sth->finish;
 456
 457     return @retval;
 458 }
 459
 460 ####################################################################
 461 ##### Misc DBI stuff...
 462 #####
 463
 464 #####
 465 # Usage: &countKeys($table, [$col]);
 466 sub countKeys {
 467     my ($table, $col) = @_;
 468     $col ||= "*";
 469     &DEBUG("&countKeys($table, $col);");
 470
 471     return (&dbRawReturn("SELECT count($col) FROM $table"))[0];
 472 }
 473
 474 #####
 475 # Usage: &sumKey($table, $col);
 476 sub sumKey {
 477     my ($table, $col) = @_;
 478
 479     return (&dbRawReturn("SELECT sum($col) FROM $table"))[0];
 480 }
 481
 482 #####
 483 # Usage: &randKey($table, $select);
 484 sub randKey {
 485     my ($table, $select) = @_;
 486     my $rand    = int(rand(&countKeys($table) - 1));
 487     my $query   = "SELECT $select FROM $table LIMIT $rand,1";
 488     if ($param{DBType} =~ /^pg/i) {
 489         $query =~ s/$rand,1/1,$rand/;
 490     }
 491
 492     my $sth     = $dbh->prepare($query);
 493     &SQLDebug($query);
 494     &WARN("randKey($query)") unless $sth->execute;
 495     my @retval  = $sth->fetchrow_array;
 496     $sth->finish;
 497
 498     return @retval;
 499 }
 500
 501 #####
 502 # Usage: &deleteTable($table);
 503 sub deleteTable {
 504     &dbRaw("deleteTable($_[0])", "DELETE FROM $_[0]");
 505 }
 506
 507 #####
 508 # Usage: &searchTable($table, $select, $key, $str);
 509 #  Note: searchTable does dbQuote.
 510 sub searchTable {
 511     my($table, $select, $key, $str) = @_;
 512     my $origStr = $str;
 513     my @results;
 514
 515     # allow two types of wildcards.
 516     if ($str =~ /^\^(.*)\$$/) {
 517         &DEBUG("searchTable: should use dbGet(), heh.");
 518         $str = $1;
 519     } else {
 520         $str .= "%"     if ($str =~ s/^\^//);
 521         $str = "%".$str if ($str =~ s/\$$//);
 522         $str = "%".$str."%" if ($str eq $origStr);      # el-cheapo fix.
 523     }
 524
 525     $str =~ s/\_/\\_/g;
 526     $str =~ s/\?/_/g;   # '.' should be supported, too.
 527     $str =~ s/\*/%/g;
 528     # end of string fix.
 529
 530     my $query = "SELECT $select FROM $table WHERE $key LIKE ".
 531                 &dbQuote($str);
 532     my $sth = $dbh->prepare($query);
 533
 534     &SQLDebug($query);
 535     if (!$sth->execute) {
 536         &WARN("Search($query)");
 537         $sth->finish;
 538         return;
 539     }
 540
 541     while (my @row = $sth->fetchrow_array) {
 542         push(@results, $row[0]);
 543     }
 544     $sth->finish;
 545
 546     return @results;
 547 }
 548
 549 sub dbCreateTable {
 550     my($table)  = @_;
 551     my(@path)   = ($bot_data_dir, ".","..","../..");
 552     my $found   = 0;
 553     my $data;
 554
 555     foreach (@path) {
 556         my $file = "$_/setup/$table.sql";
 557         &DEBUG("dbCT: table => '$table', file => '$file'");
 558         next unless ( -f $file );
 559
 560         &DEBUG("dbCT: found!!!");
 561
 562         open(IN, $file);
 563         while (<IN>) {
 564             chop;
 565             $data .= $_;
 566         }
 567
 568         $found++;
 569         last;
 570     }
 571
 572     if (!$found) {
 573         return 0;
 574     } else {
 575         &dbRaw("dbcreateTable($table)", $data);
 576         return 1;
 577     }
 578 }
 579
 580 sub checkTables {
 581     my $database_exists = 0;
 582     my %db;
 583
 584     if ($param{DBType} =~ /^mysql$/i) {
 585         my $sql = "SHOW DATABASES";
 586         foreach ( &dbRawReturn($sql) ) {
 587             $database_exists++ if ($_ eq $param{'DBName'});
 588         }
 589
 590         unless ($database_exists) {
 591             &status("Creating database $param{DBName}...");
 592             my $query = "CREATE DATABASE $param{DBName}";
 593             &dbRaw("create(db $param{DBName})", $query);
 594         }
 595
 596         # retrieve a list of db's from the server.
 597         foreach ($dbh->func('_ListTables')) {
 598             $db{$_} = 1;
 599         }
 600
 601     } elsif ($param{DBType} =~ /^SQLite$/i) {
 602
 603         # retrieve a list of db's from the server.
 604         foreach ( &dbRawReturn("SELECT name FROM sqlite_master WHERE type='table'") ) {
 605             $db{$_} = 1;
 606         }
 607
 608         # create database.
 609         if (!scalar keys %db) {
 610             &status("Creating database $param{'DBName'}...");
 611             my $query = "CREATE DATABASE $param{'DBName'}";
 612             &dbRaw("create(db $param{'DBName'})", $query);
 613         }
 614     }
 615
 616     foreach ( qw(factoids freshmeat rootwarn seen stats botmail) ) {
 617         next if (exists $db{$_});
 618         &status("checkTables: creating new table $_...");
 619
 620         &dbCreateTable($_);
 621     }
 622 }
 623
 624 1;