src/db_mysql.pl

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