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