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