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