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);
 283 sub countKeys {
 284     my ($table) = @_;
 285
 286     return (&dbRawReturn("SELECT count(*) FROM $table"))[0];
 287 }
 288
 289 ##### NOT USED.
 290 # Usage: &getKeys($table,$primkey);
 291 sub getKeys {
 292     my ($table,$primkey) = @_;
 293     my @retval;
 294
 295     my $query   = "SELECT $primkey FROM $table";
 296     my $sth     = $dbh->prepare($query);
 297
 298     &SQLDebug($query);
 299     &WARN("ERROR: getKeys($query)") unless $sth->execute;
 300
 301     while (my @row = $sth->fetchrow_array) {
 302         push(@retval, $row[0]);
 303     }
 304     $sth->finish;
 305
 306     return @retval;
 307 }
 308
 309 #####
 310 # Usage: &randKey($table, $select);
 311 sub randKey {
 312     my ($table, $select) = @_;
 313     my $rand    = int(rand(&countKeys($table) - 1));
 314     my $query   = "SELECT $select FROM $table LIMIT $rand,1";
 315
 316     my $sth     = $dbh->prepare($query);
 317     &SQLDebug($query);
 318     &WARN("randKey($query)") unless $sth->execute;
 319     my @retval  = $sth->fetchrow_array;
 320     $sth->finish;
 321
 322     return @retval;
 323 }
 324
 325 #####
 326 # Usage: &deleteTable($table);
 327 sub deleteTable {
 328     &dbRaw("deleteTable($_[0])", "DELETE FROM $_[0]");
 329 }
 330
 331 # Usage: &searchTable($table, $select, $key, $str);
 332 sub searchTable {
 333     my($table, $select, $key, $str) = @_;
 334     my $origStr = $str;
 335     my @results;
 336
 337     # allow two types of wildcards.
 338     if ($str =~ /^\^(.*)\$$/) {
 339         &DEBUG("searchTable: should use dbGet(), heh.");
 340         $str = $1;
 341     } else {
 342         $str .= "%"     if ($str =~ s/^\^//);
 343         $str = "%".$str if ($str =~ s/\$$//);
 344         $str = "%".$str."%" if ($str eq $origStr);      # el-cheapo fix.
 345     }
 346
 347     $str =~ s/\_/\\_/g;
 348     $str =~ s/\?/\_/g;  # '.' should be supported, too.
 349     # end of string fix.
 350
 351     my $query = "SELECT $select FROM $table WHERE $key LIKE ".
 352                 &dbQuote($str);
 353     my $sth = $dbh->prepare($query);
 354     &SQLDebug($query);
 355     &WARN("Search($query)") unless $sth->execute;
 356
 357     while (my @row = $sth->fetchrow_array) {
 358         push(@results, $row[0]);
 359     }
 360     $sth->finish;
 361
 362     return @results;
 363 }
 364
 365 ####################################################################
 366 ##### Factoid related stuff...
 367 #####
 368
 369 #####
 370 # Usage: &getFactInfo($faqtoid, type);
 371 sub getFactInfo {
 372     return &dbGet("factoids", "factoid_key", $_[0], $_[1]);
 373 }
 374
 375 #####
 376 # Usage: &getFactoid($faqtoid);
 377 sub getFactoid {
 378     return &getFactInfo($_[0], "factoid_value");
 379 }
 380
 381 #####
 382 # Usage: &delFactoid($faqtoid);
 383 sub delFactoid {
 384     my ($faqtoid) = @_;
 385
 386     &dbDel("factoids", "factoid_key",$faqtoid);
 387     &status("DELETED '$faqtoid'");
 388
 389     return 1;
 390 }
 391
 392 sub SQLDebug {
 393     return unless (&IsParam("SQLDebug"));
 394
 395     return if (!fileno SQLDEBUG);
 396
 397     print SQLDEBUG $_[0]."\n";
 398 }
 399
 400 1;