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