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