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         &SQLDebug($DBI::errstr);
  62         return;
  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         &SQLDebug($DBI::errstr);
  90     }
  91
  92     if (defined $type and $type == 1) {
  93         while (my @row = $sth->fetchrow_array) {
  94             # reverse it to make it easier to count.
  95             $retval{$row[1]}{$row[0]} = 1;
  96         }
  97     } else {
  98         while (my @row = $sth->fetchrow_array) {
  99             $retval{$row[0]} = $row[1];
 100         }
 101     }
 102
 103     $sth->finish;
 104
 105     return %retval;
 106 }
 107
 108 ####
 109 # Usage: &dbGetRowInfo($table);
 110 sub dbGetRowInfo {
 111     &DEBUG("STUB: dbGetRowInfo().");
 112 }
 113
 114 #####
 115 # Usage: &dbSet($table, $primkey, $primval, $key, $val);
 116 sub dbSet {
 117     my ($table, $primkey, $primval, $key, $val) = @_;
 118     my $query;
 119
 120     my $result = &dbGet($table,$primkey,$primval,$primkey);
 121     if (defined $result) {
 122         $query = "UPDATE $table SET $key=".&dbQuote($val).
 123                 " WHERE $primkey=".&dbQuote($primval);
 124     } else {
 125         $query = "INSERT INTO $table ($primkey,$key) VALUES (".
 126                 &dbQuote($primval).",".&dbQuote($val).")";
 127     }
 128
 129     &dbRaw("Set", $query);
 130
 131     return 1;
 132 }
 133
 134 #####
 135 # Usage: &dbUpdate($table, $primkey, $primval, %hash);
 136 sub dbUpdate {
 137     my ($table, $primkey, $primval, %hash) = @_;
 138     my (@array);
 139
 140     foreach (keys %hash) {
 141         push(@array, "$_=".&dbQuote($hash{$_}) );
 142     }
 143
 144     &dbRaw("Update", "UPDATE $table SET ".join(', ', @array).
 145                 " WHERE $primkey=".&dbQuote($primval)
 146     );
 147
 148     return 1;
 149 }
 150
 151 #####
 152 # Usage: &dbInsert($table, $primkey, %hash);
 153 sub dbInsert {
 154     my ($table, $primkey, %hash) = @_;
 155     my (@keys, @vals);
 156
 157     foreach (keys %hash) {
 158         push(@keys, $_);
 159         push(@vals, &dbQuote($hash{$_}));
 160     }
 161
 162     &dbRaw("Insert($table)", "INSERT INTO $table (".join(',',@keys).
 163                 ") VALUES (".join(',',@vals).")"
 164     );
 165
 166     return 1;
 167 }
 168
 169 #####
 170 # Usage: &dbSetRow($table, @values);
 171 sub dbSetRow {
 172     my ($table, @values) = @_;
 173
 174     foreach (@values) {
 175         $_ = &dbQuote($_);
 176     }
 177
 178     return &dbRaw("SetRow", "INSERT INTO $table VALUES (".
 179         join(",", @values) .")" );
 180 }
 181
 182 #####
 183 # Usage: &dbDel($table, $primkey, $primval, [$key]);
 184 sub dbDel {
 185     my ($table, $primkey, $primval, $key) = @_;
 186
 187     &dbRaw("Del", "DELETE FROM $table WHERE $primkey=".
 188                 &dbQuote($primval)
 189     );
 190
 191     return 1;
 192 }
 193
 194 # Usage: &dbRaw($prefix,$rawquery);
 195 sub dbRaw {
 196     my ($prefix,$query) = @_;
 197     my $sth;
 198
 199     if (!($sth = $dbh->prepare($query))) {
 200         &ERROR("Raw($prefix): $DBI::errstr");
 201         return 0;
 202     }
 203
 204     &SQLDebug($query);
 205     if (!$sth->execute) {
 206         &ERROR("Raw($prefix): => '$query'");
 207         &ERROR("Raw($prefix): $DBI::errstr");
 208         &SQLDebug($DBI::errstr);
 209         return 0;
 210     }
 211
 212     $sth->finish;
 213
 214     return 1;
 215 }
 216
 217 # Usage: &dbRawReturn($rawquery);
 218 sub dbRawReturn {
 219     my ($query) = @_;
 220     my @retval;
 221
 222     my $sth = $dbh->prepare($query);
 223     &SQLDebug($query);
 224     &ERROR("RawReturn => '$query'.") unless $sth->execute;
 225     while (my @row = $sth->fetchrow_array) {
 226         push(@retval, $row[0]);
 227     }
 228     $sth->finish;
 229
 230     return @retval;
 231 }
 232
 233 ####################################################################
 234 ##### Misc DBI stuff...
 235 #####
 236
 237 #####
 238 # Usage: &countKeys($table);
 239 sub countKeys {
 240     my ($table) = @_;
 241
 242     return (&dbRawReturn("SELECT count(*) FROM $table"))[0];
 243 }
 244
 245 ##### NOT USED.
 246 # Usage: &getKeys($table,$primkey);
 247 sub getKeys {
 248     my ($table,$primkey) = @_;
 249     my @retval;
 250
 251     my $query   = "SELECT $primkey FROM $table";
 252     my $sth     = $dbh->prepare($query);
 253
 254     &SQLDebug($query);
 255     &WARN("ERROR: getKeys($query)") unless $sth->execute;
 256
 257     while (my @row = $sth->fetchrow_array) {
 258         push(@retval, $row[0]);
 259     }
 260     $sth->finish;
 261
 262     return @retval;
 263 }
 264
 265 #####
 266 # Usage: &randKey($table, $select);
 267 sub randKey {
 268     my ($table, $select) = @_;
 269     my $rand    = int(rand(&countKeys($table) - 1));
 270     my $query   = "SELECT $select FROM $table LIMIT $rand,1";
 271
 272     my $sth     = $dbh->prepare($query);
 273     &SQLDebug($query);
 274     &WARN("randKey($query)") unless $sth->execute;
 275     my @retval  = $sth->fetchrow_array;
 276     $sth->finish;
 277
 278     return @retval;
 279 }
 280
 281 #####
 282 # Usage: &deleteTable($table);
 283 sub deleteTable {
 284     &dbRaw("deleteTable($_[0])", "DELETE FROM $_[0]");
 285 }
 286
 287 # Usage: &searchTable($table, $select, $key, $str);
 288 sub searchTable {
 289     my($table, $select, $key, $str) = @_;
 290     my $origStr = $str;
 291     my @results;
 292
 293     # allow two types of wildcards.
 294     if ($str =~ /^\^(.*)\$$/) {
 295         &DEBUG("searchTable: should use dbGet(), heh.");
 296         $str = $1;
 297     } else {
 298         $str .= "%"     if ($str =~ s/^\^//);
 299         $str = "%".$str if ($str =~ s/\$$//);
 300         $str = "%".$str."%" if ($str eq $origStr);      # el-cheapo fix.
 301     }
 302
 303     $str =~ s/\_/\\_/g;
 304     $str =~ s/\?/\_/g;  # '.' should be supported, too.
 305     # end of string fix.
 306
 307     my $query = "SELECT $select FROM $table WHERE $key LIKE ".
 308                 &dbQuote($str);
 309     my $sth = $dbh->prepare($query);
 310     &SQLDebug($query);
 311     &WARN("Search($query)") unless $sth->execute;
 312
 313     while (my @row = $sth->fetchrow_array) {
 314         push(@results, $row[0]);
 315     }
 316     $sth->finish;
 317
 318     return @results;
 319 }
 320
 321 ####################################################################
 322 ##### Factoid related stuff...
 323 #####
 324
 325 #####
 326 # Usage: &getFactInfo($faqtoid, type);
 327 sub getFactInfo {
 328     return &dbGet("factoids", "factoid_key", $_[0], $_[1]);
 329 }
 330
 331 #####
 332 # Usage: &getFactoid($faqtoid);
 333 sub getFactoid {
 334     return &getFactInfo($_[0], "factoid_value");
 335 }
 336
 337 #####
 338 # Usage: &delFactoid($faqtoid);
 339 sub delFactoid {
 340     my ($faqtoid) = @_;
 341
 342     &dbDel("factoids", "factoid_key",$faqtoid);
 343     &status("DELETED $faqtoid");
 344
 345     return 1;
 346 }
 347
 348 sub SQLDebug {
 349     return unless (&IsParam("SQLDebug"));
 350
 351     print SQLDEBUG $_[0]."\n";
 352 }
 353
 354 1;