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: &dbGetRowInfo($table);
 109 sub dbGetRowInfo {
 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) = @_;
 174     my (@keys, @vals);
 175
 176     foreach (keys %hash) {
 177         push(@keys, $_);
 178         push(@vals, &dbQuote($hash{$_}));
 179     }
 180
 181     &dbRaw("Insert($table)", "INSERT INTO $table (".join(',',@keys).
 182                 ") VALUES (".join(',',@vals).")"
 183     );
 184
 185     return 1;
 186 }
 187
 188 #####
 189 # Usage: &dbReplace($table, $primkey, $primval, %hash);
 190 sub dbReplace {
 191     my ($table, $primkey, $primval, %hash) = @_;
 192     my (@keys, @vals);
 193
 194     foreach (keys %hash) {
 195         &DEBUG("hash{$_} => $hash{$_}");
 196         push(@keys, $_);
 197         push(@vals, &dbQuote($hash{$_}));
 198     }
 199
 200     &dbRaw("Replace($table)", "REPLACE INTO $table (".join(',',@keys).
 201                 ") VALUES (".join(',',@vals).") WHERE $primkey=".
 202                 &dbQuote($primval)
 203     );
 204
 205     return 1;
 206 }
 207
 208 #####
 209 # Usage: &dbSetRow($table, @values);
 210 sub dbSetRow {
 211     my ($table, @values) = @_;
 212
 213     foreach (@values) {
 214         $_ = &dbQuote($_);
 215     }
 216
 217     return &dbRaw("SetRow", "INSERT INTO $table VALUES (".
 218         join(",", @values) .")" );
 219 }
 220
 221 #####
 222 # Usage: &dbDel($table, $primkey, $primval, [$key]);
 223 sub dbDel {
 224     my ($table, $primkey, $primval, $key) = @_;
 225
 226     &dbRaw("Del", "DELETE FROM $table WHERE $primkey=".
 227                 &dbQuote($primval)
 228     );
 229
 230     return 1;
 231 }
 232
 233 # Usage: &dbRaw($prefix,$rawquery);
 234 sub dbRaw {
 235     my ($prefix,$query) = @_;
 236     my $sth;
 237
 238     if (!($sth = $dbh->prepare($query))) {
 239         &ERROR("Raw($prefix): $DBI::errstr");
 240         return 0;
 241     }
 242
 243     &SQLDebug($query);
 244     if (!$sth->execute) {
 245         &ERROR("Raw($prefix): => '$query'");
 246 #       &ERROR("Raw($prefix): $DBI::errstr");
 247         $sth->finish;
 248         return 0;
 249     }
 250
 251     $sth->finish;
 252
 253     return 1;
 254 }
 255
 256 # Usage: &dbRawReturn($rawquery);
 257 sub dbRawReturn {
 258     my ($query) = @_;
 259     my @retval;
 260
 261     my $sth = $dbh->prepare($query);
 262     &SQLDebug($query);
 263     &ERROR("RawReturn => '$query'.") unless $sth->execute;
 264     while (my @row = $sth->fetchrow_array) {
 265         push(@retval, $row[0]);
 266     }
 267     $sth->finish;
 268
 269     return @retval;
 270 }
 271
 272 ####################################################################
 273 ##### Misc DBI stuff...
 274 #####
 275
 276 #####
 277 # Usage: &countKeys($table);
 278 sub countKeys {
 279     my ($table) = @_;
 280
 281     return (&dbRawReturn("SELECT count(*) FROM $table"))[0];
 282 }
 283
 284 ##### NOT USED.
 285 # Usage: &getKeys($table,$primkey);
 286 sub getKeys {
 287     my ($table,$primkey) = @_;
 288     my @retval;
 289
 290     my $query   = "SELECT $primkey FROM $table";
 291     my $sth     = $dbh->prepare($query);
 292
 293     &SQLDebug($query);
 294     &WARN("ERROR: getKeys($query)") unless $sth->execute;
 295
 296     while (my @row = $sth->fetchrow_array) {
 297         push(@retval, $row[0]);
 298     }
 299     $sth->finish;
 300
 301     return @retval;
 302 }
 303
 304 #####
 305 # Usage: &randKey($table, $select);
 306 sub randKey {
 307     my ($table, $select) = @_;
 308     my $rand    = int(rand(&countKeys($table) - 1));
 309     my $query   = "SELECT $select FROM $table LIMIT $rand,1";
 310
 311     my $sth     = $dbh->prepare($query);
 312     &SQLDebug($query);
 313     &WARN("randKey($query)") unless $sth->execute;
 314     my @retval  = $sth->fetchrow_array;
 315     $sth->finish;
 316
 317     return @retval;
 318 }
 319
 320 #####
 321 # Usage: &deleteTable($table);
 322 sub deleteTable {
 323     &dbRaw("deleteTable($_[0])", "DELETE FROM $_[0]");
 324 }
 325
 326 # Usage: &searchTable($table, $select, $key, $str);
 327 sub searchTable {
 328     my($table, $select, $key, $str) = @_;
 329     my $origStr = $str;
 330     my @results;
 331
 332     # allow two types of wildcards.
 333     if ($str =~ /^\^(.*)\$$/) {
 334         &DEBUG("searchTable: should use dbGet(), heh.");
 335         $str = $1;
 336     } else {
 337         $str .= "%"     if ($str =~ s/^\^//);
 338         $str = "%".$str if ($str =~ s/\$$//);
 339         $str = "%".$str."%" if ($str eq $origStr);      # el-cheapo fix.
 340     }
 341
 342     $str =~ s/\_/\\_/g;
 343     $str =~ s/\?/\_/g;  # '.' should be supported, too.
 344     # end of string fix.
 345
 346     my $query = "SELECT $select FROM $table WHERE $key LIKE ".
 347                 &dbQuote($str);
 348     my $sth = $dbh->prepare($query);
 349     &SQLDebug($query);
 350     &WARN("Search($query)") unless $sth->execute;
 351
 352     while (my @row = $sth->fetchrow_array) {
 353         push(@results, $row[0]);
 354     }
 355     $sth->finish;
 356
 357     return @results;
 358 }
 359
 360 ####################################################################
 361 ##### Factoid related stuff...
 362 #####
 363
 364 #####
 365 # Usage: &getFactInfo($faqtoid, type);
 366 sub getFactInfo {
 367     return &dbGet("factoids", "factoid_key", $_[0], $_[1]);
 368 }
 369
 370 #####
 371 # Usage: &getFactoid($faqtoid);
 372 sub getFactoid {
 373     return &getFactInfo($_[0], "factoid_value");
 374 }
 375
 376 #####
 377 # Usage: &delFactoid($faqtoid);
 378 sub delFactoid {
 379     my ($faqtoid) = @_;
 380
 381     &dbDel("factoids", "factoid_key",$faqtoid);
 382     &status("DELETED '$faqtoid'");
 383
 384     return 1;
 385 }
 386
 387 sub SQLDebug {
 388     return unless (&IsParam("SQLDebug"));
 389
 390     return if (!fileno SQLDEBUG);
 391
 392     print SQLDEBUG $_[0]."\n";
 393 }
 394
 395 1;