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