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     if (!$dbh) {
  29         &WARN("closeDB: connection already closed?");
  30         return 0;
  31     }
  32
  33     &status("Closed MySQL connection to $param{'SQLHost'}.");
  34     $dbh->disconnect();
  35     return 1;
  36 }
  37
  38 #####
  39 # Usage: &dbQuote($str);
  40 sub dbQuote {
  41     return $dbh->quote($_[0]);
  42 }
  43
  44 #####
  45 # Usage: &dbGet($table, $primkey, $primval, $select);
  46 sub dbGet {
  47     my ($table, $primkey, $primval, $select) = @_;
  48     my $query = "SELECT $select FROM $table WHERE $primkey=".
  49                 &dbQuote($primval);
  50
  51     my $sth;
  52     if (!($sth = $dbh->prepare($query))) {
  53         &ERROR("Get: $DBI::errstr");
  54         return;
  55     }
  56
  57     &SQLDebug($query);
  58     if (!$sth->execute) {
  59         &ERROR("Get => '$query'");
  60         &ERROR("Get => $DBI::errstr");
  61         $sth->finish;
  62         return 0;
  63     }
  64
  65     my @retval = $sth->fetchrow_array;
  66
  67     $sth->finish;
  68
  69     if (scalar @retval > 1) {
  70         return @retval;
  71     } elsif (scalar @retval == 1) {
  72         return $retval[0];
  73     } else {
  74         return;
  75     }
  76 }
  77
  78 #####
  79 # Usage: &dbGetCol($table, $primkey, $key, [$type]);
  80 sub dbGetCol {
  81     my ($table, $primkey, $key, $type) = @_;
  82     my $query = "SELECT $primkey,$key FROM $table WHERE $key IS NOT NULL";
  83     my %retval;
  84
  85     my $sth = $dbh->prepare($query);
  86     &SQLDebug($query);
  87     if (!$sth->execute) {
  88         &ERROR("GetCol => '$query'");
  89         &ERROR("GetCol => $DBI::errstr");
  90         $sth->finish;
  91         return;
  92     }
  93
  94     if (defined $type and $type == 1) {
  95         while (my @row = $sth->fetchrow_array) {
  96             # reverse it to make it easier to count.
  97             $retval{$row[1]}{$row[0]} = 1;
  98         }
  99     } else {
 100         while (my @row = $sth->fetchrow_array) {
 101             $retval{$row[0]} = $row[1];
 102         }
 103     }
 104
 105     $sth->finish;
 106
 107     return %retval;
 108 }
 109
 110 ####
 111 # Usage: &dbGetRowInfo($table);
 112 sub dbGetRowInfo {
 113     my ($table) = @_;
 114
 115     my $query = "SHOW COLUMNS from $table";
 116     my %retval;
 117
 118     my $sth = $dbh->prepare($query);
 119     &SQLDebug($query);
 120     if (!$sth->execute) {
 121         &ERROR("GRI => '$query'");
 122         &ERROR("GRI => $DBI::errstr");
 123         $sth->finish;
 124         return;
 125     }
 126
 127     my @cols;
 128     while (my @row = $sth->fetchrow_array) {
 129         push(@cols, $row[0]);
 130     }
 131     $sth->finish;
 132
 133     return @cols;
 134 }
 135
 136 #####
 137 # Usage: &dbSet($table, $primkey, $primval, $key, $val);
 138 sub dbSet {
 139     my ($table, $primkey, $primval, $key, $val) = @_;
 140     my $query;
 141
 142     my $result = &dbGet($table,$primkey,$primval,$primkey);
 143     if (defined $result) {
 144         $query = "UPDATE $table SET $key=".&dbQuote($val).
 145                 " WHERE $primkey=".&dbQuote($primval);
 146     } else {
 147         $query = "INSERT INTO $table ($primkey,$key) VALUES (".
 148                 &dbQuote($primval).",".&dbQuote($val).")";
 149     }
 150
 151     &dbRaw("Set", $query);
 152
 153     return 1;
 154 }
 155
 156 #####
 157 # Usage: &dbUpdate($table, $primkey, $primval, %hash);
 158 sub dbUpdate {
 159     my ($table, $primkey, $primval, %hash) = @_;
 160     my (@array);
 161
 162     foreach (keys %hash) {
 163         push(@array, "$_=".&dbQuote($hash{$_}) );
 164     }
 165
 166     &dbRaw("Update", "UPDATE $table SET ".join(', ', @array).
 167                 " WHERE $primkey=".&dbQuote($primval)
 168     );
 169
 170     return 1;
 171 }
 172
 173 #####
 174 # Usage: &dbInsert($table, $primkey, %hash);
 175 sub dbInsert {
 176     my ($table, $primkey, %hash) = @_;
 177     my (@keys, @vals);
 178
 179     foreach (keys %hash) {
 180         push(@keys, $_);
 181         push(@vals, &dbQuote($hash{$_}));
 182     }
 183
 184     &dbRaw("Insert($table)", "INSERT INTO $table (".join(',',@keys).
 185                 ") VALUES (".join(',',@vals).")"
 186     );
 187
 188     return 1;
 189 }
 190
 191 #####
 192 # Usage: &dbSetRow($table, @values);
 193 sub dbSetRow {
 194     my ($table, @values) = @_;
 195
 196     foreach (@values) {
 197         $_ = &dbQuote($_);
 198     }
 199
 200     return &dbRaw("SetRow", "INSERT INTO $table VALUES (".
 201         join(",", @values) .")" );
 202 }
 203
 204 #####
 205 # Usage: &dbDel($table, $primkey, $primval, [$key]);
 206 sub dbDel {
 207     my ($table, $primkey, $primval, $key) = @_;
 208
 209     &dbRaw("Del", "DELETE FROM $table WHERE $primkey=".
 210                 &dbQuote($primval)
 211     );
 212
 213     return 1;
 214 }
 215
 216 # Usage: &dbRaw($prefix,$rawquery);
 217 sub dbRaw {
 218     my ($prefix,$query) = @_;
 219     my $sth;
 220
 221     if (!($sth = $dbh->prepare($query))) {
 222         &ERROR("Raw($prefix): $DBI::errstr");
 223         return 0;
 224     }
 225
 226     &SQLDebug($query);
 227     if (!$sth->execute) {
 228         &ERROR("Raw($prefix): => '$query'");
 229         &ERROR("Raw($prefix): $DBI::errstr");
 230         $sth->finish;
 231         return 0;
 232     }
 233
 234     $sth->finish;
 235
 236     return 1;
 237 }
 238
 239 # Usage: &dbRawReturn($rawquery);
 240 sub dbRawReturn {
 241     my ($query) = @_;
 242     my @retval;
 243
 244     my $sth = $dbh->prepare($query);
 245     &SQLDebug($query);
 246     &ERROR("RawReturn => '$query'.") unless $sth->execute;
 247     while (my @row = $sth->fetchrow_array) {
 248         push(@retval, $row[0]);
 249     }
 250     $sth->finish;
 251
 252     return @retval;
 253 }
 254
 255 ####################################################################
 256 ##### Misc DBI stuff...
 257 #####
 258
 259 #####
 260 # Usage: &countKeys($table);
 261 sub countKeys {
 262     my ($table) = @_;
 263
 264     return (&dbRawReturn("SELECT count(*) FROM $table"))[0];
 265 }
 266
 267 ##### NOT USED.
 268 # Usage: &getKeys($table,$primkey);
 269 sub getKeys {
 270     my ($table,$primkey) = @_;
 271     my @retval;
 272
 273     my $query   = "SELECT $primkey FROM $table";
 274     my $sth     = $dbh->prepare($query);
 275
 276     &SQLDebug($query);
 277     &WARN("ERROR: getKeys($query)") unless $sth->execute;
 278
 279     while (my @row = $sth->fetchrow_array) {
 280         push(@retval, $row[0]);
 281     }
 282     $sth->finish;
 283
 284     return @retval;
 285 }
 286
 287 #####
 288 # Usage: &randKey($table, $select);
 289 sub randKey {
 290     my ($table, $select) = @_;
 291     my $rand    = int(rand(&countKeys($table) - 1));
 292     my $query   = "SELECT $select FROM $table LIMIT $rand,1";
 293
 294     my $sth     = $dbh->prepare($query);
 295     &SQLDebug($query);
 296     &WARN("randKey($query)") unless $sth->execute;
 297     my @retval  = $sth->fetchrow_array;
 298     $sth->finish;
 299
 300     return @retval;
 301 }
 302
 303 #####
 304 # Usage: &deleteTable($table);
 305 sub deleteTable {
 306     &dbRaw("deleteTable($_[0])", "DELETE FROM $_[0]");
 307 }
 308
 309 # Usage: &searchTable($table, $select, $key, $str);
 310 sub searchTable {
 311     my($table, $select, $key, $str) = @_;
 312     my $origStr = $str;
 313     my @results;
 314
 315     # allow two types of wildcards.
 316     if ($str =~ /^\^(.*)\$$/) {
 317         &DEBUG("searchTable: should use dbGet(), heh.");
 318         $str = $1;
 319     } else {
 320         $str .= "%"     if ($str =~ s/^\^//);
 321         $str = "%".$str if ($str =~ s/\$$//);
 322         $str = "%".$str."%" if ($str eq $origStr);      # el-cheapo fix.
 323     }
 324
 325     $str =~ s/\_/\\_/g;
 326     $str =~ s/\?/\_/g;  # '.' should be supported, too.
 327     # end of string fix.
 328
 329     my $query = "SELECT $select FROM $table WHERE $key LIKE ".
 330                 &dbQuote($str);
 331     my $sth = $dbh->prepare($query);
 332     &SQLDebug($query);
 333     &WARN("Search($query)") unless $sth->execute;
 334
 335     while (my @row = $sth->fetchrow_array) {
 336         push(@results, $row[0]);
 337     }
 338     $sth->finish;
 339
 340     return @results;
 341 }
 342
 343 ####################################################################
 344 ##### Factoid related stuff...
 345 #####
 346
 347 #####
 348 # Usage: &getFactInfo($faqtoid, type);
 349 sub getFactInfo {
 350     return &dbGet("factoids", "factoid_key", $_[0], $_[1]);
 351 }
 352
 353 #####
 354 # Usage: &getFactoid($faqtoid);
 355 sub getFactoid {
 356     return &getFactInfo($_[0], "factoid_value");
 357 }
 358
 359 #####
 360 # Usage: &delFactoid($faqtoid);
 361 sub delFactoid {
 362     my ($faqtoid) = @_;
 363
 364     &dbDel("factoids", "factoid_key",$faqtoid);
 365     &status("DELETED $faqtoid");
 366
 367     return 1;
 368 }
 369
 370 sub SQLDebug {
 371     return unless (&IsParam("SQLDebug"));
 372
 373     return if (!fileno SQLDEBUG);
 374
 375     print SQLDEBUG $_[0]."\n";
 376 }
 377
 378 1;