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