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