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