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