src/db_pgsql.pl

   1 #
   2 # db_pgsql.pl: PostgreSQL database frontend.
   3 #      Author: dms
   4 #     Version: v0.2 (20010908)
   5 #     Created: 20000629
   6 #
   7
   8 if (&IsParam("useStrict")) { use strict; }
   9
  10 sub openDB {
  11     my $connectstr="dbi:Pg:dbname=$param{DBName};";
  12     $connectstr.=";host=$param{SQLHost}" if(defined $param{'SQLHost'});
  13     $dbh = DBI->connect($connectstr, $param{'SQLUser'}, $param{'SQLPass'});
  14
  15     if (!$dbh->err) {
  16         &status("Opened PgSQL connection to $param{'SQLHost'}");
  17     } else {
  18         &ERROR("cannot connect to $param{'SQLHost'}.");
  19         &ERROR("pgSQL: ".$dbh->errstr);
  20
  21         &closePID();
  22         &closeSHM($shm);
  23         &closeLog();
  24
  25         exit 1;
  26     }
  27 }
  28
  29 sub closeDB {
  30     return 0 unless ($dbh);
  31
  32     &status("Closed pgSQL connection to $param{'SQLHost'}.");
  33     $dbh->disconnect();
  34
  35     return 1;
  36 }
  37
  38 #####
  39 # Usage: &dbQuote($str);
  40 sub dbQuote {
  41     return $dbh->quote($_[0]);
  42
  43     $_ = $_[0];
  44     s/'/\\'/g;
  45     return "'$_'";
  46 }
  47
  48 #####
  49 # Usage: &dbGet($table, $select, $where);
  50 sub dbGet {
  51     my ($table, $select, $where) = @_;
  52     my $query   = "SELECT $select FROM $table";
  53     $query      .= " WHERE $where" if ($where);
  54
  55     if (!defined $select) {
  56         &WARN("dbGet: select == NULL. table => $table");
  57         return;
  58     }
  59
  60     my $sth;
  61     if (!($sth = $dbh->prepare($query))) {
  62         &ERROR("Get: prepare: $DBI::errstr");
  63         return;
  64     }
  65
  66     &SQLDebug($query);
  67     if (!$sth->execute) {
  68         &ERROR("Get: execute: '$query'");
  69         $sth->finish;
  70         return 0;
  71     }
  72
  73     my @retval = $sth->fetchrow_array;
  74
  75     $sth->finish;
  76
  77     if (scalar @retval > 1) {
  78         return @retval;
  79     } elsif (scalar @retval == 1) {
  80         return $retval[0];
  81     } else {
  82         return;
  83     }
  84 }
  85
  86 #####
  87 # Usage: &dbGetCol($table, $select, $where, [$type]);
  88 sub dbGetCol {
  89     my ($table, $select, $where, $type) = @_;
  90     my $query   = "SELECT $select FROM $table";
  91     $query      .= " WHERE ".$where if ($where);
  92     my %retval;
  93
  94     my $sth = $dbh->prepare($query);
  95     &SQLDebug($query);
  96     if (!$sth->execute) {
  97         &ERROR("GetCol: execute: '$query'");
  98         $sth->finish;
  99         return;
 100     }
 101
 102     if (defined $type and $type == 2) {
 103         &DEBUG("dbgetcol: type 2!");
 104         while (my @row = $sth->fetchrow_array) {
 105             $retval{$row[0]} = join(':', $row[1..$#row]);
 106         }
 107         &DEBUG("dbgetcol: count => ".scalar(keys %retval) );
 108
 109     } elsif (defined $type and $type == 1) {
 110         while (my @row = $sth->fetchrow_array) {
 111             # reverse it to make it easier to count.
 112             if (scalar @row == 2) {
 113                 $retval{$row[1]}{$row[0]} = 1;
 114             } elsif (scalar @row == 3) {
 115                 $retval{$row[1]}{$row[0]} = 1;
 116             }
 117             # what to do if there's only one or more than 3?
 118         }
 119     } else {
 120         while (my @row = $sth->fetchrow_array) {
 121             $retval{$row[0]} = $row[1];
 122         }
 123     }
 124
 125     $sth->finish;
 126
 127     return %retval;
 128 }
 129
 130 #####
 131 # Usage: &dbGetColNiceHash($table, $select, $where);
 132 sub dbGetColNiceHash {
 133     my ($table, $select, $where) = @_;
 134     $select     ||= "*";
 135     my $query   = "SELECT $select FROM $table";
 136     $query      .= " WHERE ".$where if ($where);
 137     my %retval;
 138
 139     &DEBUG("dbGetColNiceHash: query => '$query'.");
 140
 141     my $sth = $dbh->prepare($query);
 142     &SQLDebug($query);
 143     if (!$sth->execute) {
 144         &ERROR("GetColNiceHash: execute: '$query'");
 145 #       &ERROR("GetCol => $DBI::errstr");
 146         $sth->finish;
 147         return;
 148     }
 149
 150     # todo: get column names, do $hash{$primkey}{blah} = ...
 151     while (my @row = $sth->fetchrow_array) {
 152         # todo: reverse it to make it easier to count.
 153     }
 154
 155     $sth->finish;
 156
 157     return %retval;
 158 }
 159
 160 ####
 161 # Usage: &dbGetColInfo($table);
 162 sub dbGetColInfo {
 163     my ($table) = @_;
 164
 165 #    my $query = "SELECT * FROM $table LIMIT 1;";
 166     my $query = "SHOW COLUMNS from $table";
 167     my %retval;
 168
 169     my $sth = $dbh->prepare($query);
 170     &SQLDebug($query);
 171     if (!$sth->execute) {
 172         &ERROR("GRI => '$query'");
 173         &ERROR("GRI => $DBI::errstr");
 174         $sth->finish;
 175         return;
 176     }
 177
 178     if (0) {
 179         %retval=%{$sth->fetchrow_hashref()};
 180         return keys %retval;
 181     }
 182
 183     my @cols;
 184     while (my @row = $sth->fetchrow_array) {
 185         push(@cols, $row[0]);
 186     }
 187     $sth->finish;
 188
 189     return @cols;
 190 }
 191
 192 #####
 193 # Usage: &dbSet($table, $primhash_ref, $hash_ref);
 194 #  Note: dbSet does dbQuote.
 195 sub dbSet {
 196     my ($table, $phref, $href) = @_;
 197     my $where = join(' AND ', map {
 198                 $_."=".&dbQuote($phref->{$_})
 199         } keys %{$phref}
 200     );
 201
 202     my $result = &dbGet($table, join(',', keys %{$phref}), $where);
 203
 204     my(@keys,@vals);
 205     foreach (keys %{$href}) {
 206         push(@keys, $_);
 207         push(@vals, &dbQuote($href->{$_}) );
 208     }
 209
 210     if (!@keys or !@vals) {
 211         &WARN("dbset: keys or vals is NULL.");
 212         return;
 213     }
 214
 215     my $query;
 216     if (defined $result) {
 217         my @keyval;
 218         for(my$i=0; $i<scalar @keys; $i++) {
 219             push(@keyval, $keys[$i]."=".$vals[$i] );
 220         }
 221
 222         $query = "UPDATE $table SET ".
 223                 join(' AND ', @keyval).
 224                 " WHERE $where";
 225     } else {
 226         foreach (keys %{$phref}) {
 227             push(@keys, $_);
 228             push(@vals, &dbQuote($phref->{$_}) );
 229         }
 230
 231         $query = sprintf("INSERT INTO $table (%s) VALUES (%s)",
 232                 join(',',@keys), join(',',@vals) );
 233     }
 234
 235     &dbRaw("Set", $query);
 236
 237     return 1;
 238 }
 239
 240 #####
 241 # Usage: &dbUpdate($table, $primkey, $primval, %hash);
 242 sub dbUpdate {
 243     my ($table, $primkey, $primval, %hash) = @_;
 244     my (@array);
 245
 246     foreach (keys %hash) {
 247         push(@array, "$_=".&dbQuote($hash{$_}) );
 248     }
 249
 250     &dbRaw("Update", "UPDATE $table SET ".join(', ', @array).
 251                 " WHERE $primkey=".&dbQuote($primval)
 252     );
 253
 254     return 1;
 255 }
 256
 257 #####
 258 # Usage: &dbInsert($table, $primkey, $primval, %hash);
 259 sub dbInsert {
 260     my ($table, $primkey, $primval, %hash, $delay) = @_;
 261     my (@keys, @vals);
 262     my $p       = "";
 263
 264     if ($delay) {
 265         &DEBUG("dbI: delay => $delay");
 266         $p      = " DELAYED";
 267     }
 268
 269     foreach (keys %hash) {
 270         push(@keys, $_);
 271         push(@vals, &dbQuote($hash{$_}));
 272     }
 273
 274     &dbRaw("Insert($table)", "INSERT $p INTO $table (".join(',',@keys).
 275                ") VALUES (".join(',',@vals).")"
 276     );
 277
 278     return 1;
 279 }
 280
 281 #####
 282 # Usage: &dbReplace($table, %hash);
 283 #  Note: dbReplace does optional dbQuote.
 284 sub dbReplace {
 285     my ($table, %hash) = @_;
 286     my (@keys, @vals);
 287     my $iquery = "INSERT INTO $table ";
 288     my $uquery = "UPDATE $table SET ";
 289
 290     foreach (keys %hash) {
 291         if (s/^-//) {   # as is.
 292             push(@keys, $_);
 293             push(@vals, $hash{'-'.$_});
 294         } else {
 295             push(@keys, $_);
 296             push(@vals, &dbQuote($hash{$_}));
 297         }
 298         $uquery .= "$keys[-1] = $vals[-1], ";
 299     }
 300     $uquery = ~s/, $/;/;
 301     $iquery .= "(". join(',',@keys) .") VALUES (". join(',',@vals) .");";
 302
 303     &DEBUG($query) if (0);
 304
 305     if(!&dbRaw("Replace($table)", $iquery)) {
 306         &dbRaw("Replace($table)", $uquery);
 307     }
 308
 309     return 1;
 310 }
 311
 312 #####
 313 # Usage: &dbSetRow($table, $vref, $delay);
 314 #  Note: dbSetRow does dbQuote.
 315 sub dbSetRow ($@$) {
 316     my ($table, $vref, $delay) = @_;
 317     my $p      = ($delay) ? " DELAYED " : "";
 318
 319     # see 'perldoc perlreftut'
 320     my @values;
 321     foreach (@{ $vref }) {
 322         push(@values, &dbQuote($_) );
 323     }
 324
 325     if (!scalar @values) {
 326         &WARN("dbSetRow: values array == NULL.");
 327         return;
 328     }
 329
 330     return &dbRaw("SetRow", "INSERT $p INTO $table VALUES (".
 331         join(",", @values) .")" );
 332 }
 333
 334 #####
 335 # Usage: &dbDel($table, $primkey, $primval, [$key]);
 336 #  Note: dbDel does dbQuote
 337 sub dbDel {
 338     my ($table, $primkey, $primval, $key) = @_;
 339
 340     &dbRaw("Del", "DELETE FROM $table WHERE $primkey=".
 341                 &dbQuote($primval)
 342     );
 343
 344     return 1;
 345 }
 346
 347 # Usage: &dbRaw($prefix,$rawquery);
 348 sub dbRaw {
 349     my ($prefix,$query) = @_;
 350     my $sth;
 351
 352     if (!($sth = $dbh->prepare($query))) {
 353         &ERROR("Raw($prefix): $DBI::errstr");
 354         return 0;
 355     }
 356
 357     &SQLDebug($query);
 358     if (!$sth->execute) {
 359         &ERROR("Raw($prefix): => '$query'");
 360         $sth->finish;
 361         return 0;
 362     }
 363
 364     $sth->finish;
 365
 366     return 1;
 367 }
 368
 369 # Usage: &dbRawReturn($rawquery);
 370 sub dbRawReturn {
 371     my ($query) = @_;
 372     my @retval;
 373
 374     my $sth = $dbh->prepare($query);
 375     &SQLDebug($query);
 376     &ERROR("RawReturn => '$query'.") unless $sth->execute;
 377     while (my @row = $sth->fetchrow_array) {
 378         push(@retval, $row[0]);
 379     }
 380     $sth->finish;
 381
 382     return @retval;
 383 }
 384
 385 ####################################################################
 386 ##### Misc DBI stuff...
 387 #####
 388
 389 #####
 390 # Usage: &countKeys($table, [$col]);
 391 sub countKeys {
 392     my ($table, $col) = @_;
 393     $col ||= "*";
 394
 395     return (&dbRawReturn("SELECT count($col) FROM $table"))[0];
 396 }
 397
 398 # Usage: &sumKey($table, $col);
 399 sub sumKey {
 400     my ($table, $col) = @_;
 401
 402     return (&dbRawReturn("SELECT sum($col) FROM $table"))[0];
 403 }
 404
 405 #####
 406 # Usage: &randKey($table, $select);
 407 sub randKey {
 408     my ($table, $select) = @_;
 409     my $rand    = int(rand(&countKeys($table) - 1));
 410     my $query   = "SELECT $select FROM $table LIMIT $rand,1";
 411
 412     my $sth     = $dbh->prepare($query);
 413     &SQLDebug($query);
 414     &WARN("randKey($query)") unless $sth->execute;
 415     my @retval  = $sth->fetchrow_array;
 416     $sth->finish;
 417
 418     return @retval;
 419 }
 420
 421 #####
 422 # Usage: &deleteTable($table);
 423 sub deleteTable {
 424     &dbRaw("deleteTable($_[0])", "DELETE FROM $_[0]");
 425 }
 426
 427 #####
 428 # Usage: &searchTable($table, $select, $key, $str);
 429 #  Note: searchTable does dbQuote.
 430 sub searchTable {
 431     my($table, $select, $key, $str) = @_;
 432     my $origStr = $str;
 433     my @results;
 434
 435     # allow two types of wildcards.
 436     if ($str =~ /^\^(.*)\$$/) {
 437         &DEBUG("searchTable: should use dbGet(), heh.");
 438         $str = $1;
 439     } else {
 440         $str .= "%"     if ($str =~ s/^\^//);
 441         $str = "%".$str if ($str =~ s/\$$//);
 442         $str = "%".$str."%" if ($str eq $origStr);      # el-cheapo fix.
 443     }
 444
 445     $str =~ s/\_/\\_/g;
 446     $str =~ s/\?/\_/g;  # '.' should be supported, too.
 447     # end of string fix.
 448
 449     my $query = "SELECT $select FROM $table WHERE $key LIKE ".
 450                 &dbQuote($str);
 451     my $sth = $dbh->prepare($query);
 452     &SQLDebug($query);
 453     if (!$sth->execute) {
 454         &WARN("Search($query)");
 455         return;
 456     }
 457
 458     while (my @row = $sth->fetchrow_array) {
 459         push(@results, $row[0]);
 460     }
 461     $sth->finish;
 462
 463     return @results;
 464 }
 465
 466 ####################################################################
 467 ##### Factoid related stuff...
 468 #####
 469
 470 #####
 471 # Usage: &getFactInfo($faqtoid, $type);
 472 #  Note: getFactInfo does dbQuote
 473 sub getFactInfo {
 474     return &dbGet("factoids", $_[1], "factoid_key=".&dbQuote($_[0]) );
 475 }
 476
 477 #####
 478 # Usage: &getFactoid($faqtoid);
 479 sub getFactoid {
 480     return &getFactInfo($_[0], "factoid_value");
 481 }
 482
 483 #####
 484 # Usage: &delFactoid($faqtoid);
 485 sub delFactoid {
 486     my ($faqtoid) = @_;
 487
 488     &dbDel("factoids", "factoid_key",$faqtoid);
 489     &status("DELETED '$faqtoid'");
 490
 491     return 1;
 492 }
 493
 494 #####
 495 #
 496 sub checkTables {
 497     &FIXME("pgsql: checkTables(@_);");
 498     return 1;
 499 }
 500
 501 1;