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