src/db_mysql.pl

   1 #
   2 # db_mysql.pl: MySQL database frontend.
   3 #      Author: xk <xk@leguin.openprojects.net>
   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 $dsn = "DBI:mysql:$param{'DBName'}:$param{'SQLHost'}";
  14     $dbh    = DBI->connect($dsn, $param{'SQLUser'}, $param{'SQLPass'});
  15
  16     if ($dbh) {
  17         &status("Opened MySQL connection to $param{'SQLHost'}");
  18     } else {
  19         &ERROR("cannot connect to $param{'SQLHost'}.");
  20         &shutdown();
  21         &closePID();
  22         exit 1;
  23     }
  24 }
  25
  26 sub closeDB {
  27     if (!$dbh) {
  28         &WARN("closeDB: connection already closed?");
  29         return 0;
  30     }
  31
  32     &status("Closed MySQL connection to $param{'SQLHost'}.");
  33     $dbh->disconnect();
  34     return 1;
  35 }
  36
  37 #####
  38 # Usage: &dbQuote($str);
  39 sub dbQuote {
  40     return $dbh->quote($_[0]);
  41 }
  42
  43 #####
  44 # Usage: &dbGet($table, $primkey, $primval, $select);
  45 sub dbGet {
  46     my ($table, $primkey, $primval, $select) = @_;
  47     my $query = "SELECT $select FROM $table WHERE $primkey=".
  48                 &dbQuote($primval);
  49
  50     my $sth;
  51     if (!($sth = $dbh->prepare($query))) {
  52         &ERROR("Get: $DBI::errstr");
  53         return;
  54     }
  55
  56     if (!$sth->execute) {
  57         &ERROR("Get => '$query'");
  58         &ERROR("Get => $DBI::errstr");
  59         return;
  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     &ERROR("GetCol => '$query'") unless $sth->execute;
  84
  85     if (defined $type and $type == 1) {
  86         while (my @row = $sth->fetchrow_array) {
  87             # reverse it to make it easier to count.
  88             $retval{$row[1]}{$row[0]} = 1;
  89         }
  90     } else {
  91         while (my @row = $sth->fetchrow_array) {
  92             $retval{$row[0]} = $row[1];
  93         }
  94     }
  95
  96     $sth->finish;
  97
  98     return %retval;
  99 }
 100
 101 ####
 102 # Usage: &dbGetRowInfo($table);
 103 sub dbGetRowInfo {
 104     &DEBUG("STUB: dbGetRowInfo().");
 105 }
 106
 107 #####
 108 # Usage: &dbSet($table, $primkey, $primval, $key, $val);
 109 sub dbSet {
 110     my ($table, $primkey, $primval, $key, $val) = @_;
 111     my $query;
 112
 113     my $result = &dbGet($table,$primkey,$primval,$primkey);
 114     if (defined $result) {
 115         $query = "UPDATE $table SET $key=".&dbQuote($val).
 116                 " WHERE $primkey=".&dbQuote($primval);
 117     } else {
 118         $query = "INSERT INTO $table ($primkey,$key) VALUES (".
 119                 &dbQuote($primval).",".&dbQuote($val).")";
 120     }
 121
 122     &dbRaw("Set", $query);
 123
 124     return 1;
 125 }
 126
 127 #####
 128 # Usage: &dbUpdate($table, $primkey, $primval, %hash);
 129 sub dbUpdate {
 130     my ($table, $primkey, $primval, %hash) = @_;
 131     my (@array);
 132
 133     foreach (keys %hash) {
 134         push(@array, "$_=".&dbQuote($hash{$_}) );
 135     }
 136
 137     &dbRaw("Update", "UPDATE $table SET ".join(', ', @array).
 138                 " WHERE $primkey=".&dbQuote($primval)
 139     );
 140
 141     return 1;
 142 }
 143
 144 #####
 145 # Usage: &dbInsert($table, $primkey, %hash);
 146 sub dbInsert {
 147     my ($table, $primkey, %hash) = @_;
 148     my (@keys, @vals);
 149
 150     foreach (keys %hash) {
 151         push(@keys, $_);
 152         push(@vals, &dbQuote($hash{$_}));
 153     }
 154
 155     &dbRaw("Insert($table)", "INSERT INTO $table (".join(',',@keys).
 156                 ") VALUES (".join(',',@vals).")"
 157     );
 158
 159     return 1;
 160 }
 161
 162 #####
 163 # Usage: &dbSetRow($table, @values);
 164 sub dbSetRow {
 165     my ($table, @values) = @_;
 166
 167     foreach (@values) {
 168         $_ = &dbQuote($_);
 169     }
 170
 171     return &dbRaw("SetRow", "INSERT INTO $table VALUES (".
 172         join(",", @values) .")" );
 173 }
 174
 175 #####
 176 # Usage: &dbDel($table, $primkey, $primval, [$key]);
 177 sub dbDel {
 178     my ($table, $primkey, $primval, $key) = @_;
 179
 180     &dbRaw("Del", "DELETE FROM $table WHERE $primkey=".
 181                 &dbQuote($primval)
 182     );
 183
 184     return 1;
 185 }
 186
 187 # Usage: &dbRaw($prefix,$rawquery);
 188 sub dbRaw {
 189     my ($prefix,$query) = @_;
 190     my $sth;
 191
 192     if (!($sth = $dbh->prepare($query))) {
 193         &ERROR("Raw($prefix): $DBI::errstr");
 194         return 0;
 195     }
 196
 197     if (!$sth->execute) {
 198         &ERROR("Raw($prefix): => '$query'");
 199         &ERROR("Raw($prefix): $DBI::errstr");
 200         return 0;
 201     }
 202
 203     $sth->finish;
 204
 205     return 1;
 206 }
 207
 208 # Usage: &dbRawReturn($rawquery);
 209 sub dbRawReturn {
 210     my ($query) = @_;
 211     my @retval;
 212
 213     my $sth = $dbh->prepare($query);
 214     &ERROR("RawReturn => '$query'.") unless $sth->execute;
 215     while (my @row = $sth->fetchrow_array) {
 216         push(@retval, $row[0]);
 217     }
 218     $sth->finish;
 219
 220     return @retval;
 221 }
 222
 223 ####################################################################
 224 ##### Misc DBI stuff...
 225 #####
 226
 227 #####
 228 # Usage: &countKeys($table);
 229 sub countKeys {
 230     my ($table) = @_;
 231
 232     return (&dbRawReturn("SELECT count(*) FROM $table"))[0];
 233 }
 234
 235 ##### NOT USED.
 236 # Usage: &getKeys($table,$primkey);
 237 sub getKeys {
 238     my ($table,$primkey) = @_;
 239     my @retval;
 240
 241     my $query   = "SELECT $primkey FROM $table";
 242     my $sth     = $dbh->prepare($query);
 243
 244     $sth->execute;
 245     while (my @row = $sth->fetchrow_array) {
 246         push(@retval, $row[0]);
 247     }
 248     $sth->finish;
 249
 250     return @retval;
 251 }
 252
 253 #####
 254 # Usage: &randKey($table, $select);
 255 sub randKey {
 256     my ($table, $select) = @_;
 257     my $rand    = int(rand(&countKeys($table) - 1));
 258     my $query   = "SELECT $select FROM $table LIMIT $rand,1";
 259
 260     my $sth     = $dbh->prepare($query);
 261     $sth->execute;
 262     my @retval  = $sth->fetchrow_array;
 263     $sth->finish;
 264
 265     return @retval;
 266 }
 267
 268 #####
 269 # Usage: &deleteTable($table);
 270 sub deleteTable {
 271     &dbRaw("deleteTable($_[0])", "DELETE FROM $_[0]");
 272 }
 273
 274 # Usage: &searchTable($table, $select, $key, $str);
 275 sub searchTable {
 276     my($table, $select, $key, $str) = @_;
 277     my $origStr = $str;
 278     my @results;
 279
 280     # allow two types of wildcards.
 281     if ($str =~ /^\^(.*)\$$/) {
 282         &DEBUG("searchTable: should use dbGet(), heh.");
 283         $str = $1;
 284     } else {
 285         $str .= "%"     if ($str =~ s/^\^//);
 286         $str = "%".$str if ($str =~ s/\$$//);
 287         $str = "%".$str."%" if ($str eq $origStr);      # el-cheapo fix.
 288     }
 289
 290     $str =~ s/\_/\\_/g;
 291     $str =~ s/\?/\_/g;  # '.' should be supported, too.
 292     # end of string fix.
 293
 294     my $query = "SELECT $select FROM $table WHERE $key LIKE ".
 295                 &dbQuote($str);
 296     my $sth = $dbh->prepare($query);
 297     $sth->execute;
 298
 299     while (my @row = $sth->fetchrow_array) {
 300         push(@results, $row[0]);
 301     }
 302     $sth->finish;
 303
 304     return @results;
 305 }
 306
 307 ####################################################################
 308 ##### Factoid related stuff...
 309 #####
 310
 311 #####
 312 # Usage: &getFactInfo($faqtoid, type);
 313 sub getFactInfo {
 314     return &dbGet("factoids", "factoid_key", $_[0], $_[1]);
 315 }
 316
 317 #####
 318 # Usage: &getFactoid($faqtoid);
 319 sub getFactoid {
 320     return &getFactInfo($_[0], "factoid_value");
 321 }
 322
 323 #####
 324 # Usage: &delFactoid($faqtoid);
 325 sub delFactoid {
 326     my ($faqtoid) = @_;
 327
 328     &dbDel("factoids", "factoid_key",$faqtoid);
 329     &status("DELETED $faqtoid");
 330
 331     return 1;
 332 }
 333
 334 1;