src/db_pgsql.pl

   1 #
   2 # db_pgsql.pl: PostgreSQL database frontend.
   3 #      Author: dms <dms@users.sourceforge.net>
   4 #     Version: v0.1 (20000629)
   5 #     Created: 20000629
   6 #
   7
   8 if (&IsParam("useStrict")) { use strict; }
   9
  10 sub openDB {
  11     $dbh = Pg::connectdb("dbname=$param{'DBName'}");
  12 #    $dbh = Pg::setdbLogin($param{'SQLHost'}, , , , $param{'DBName'},
  13 #       $param{'SQLUser'}, $param{'SQLPass'});
  14
  15     if (PGRES_CONNECTION_OK eq $dbh->status) {
  16         &status("Opened pgSQL connection to $param{'SQLHost'}");
  17     } else {
  18         &ERROR("cannot connect to $param{'SQLHost'}.");
  19         &ERROR("pgSQL: ".$dbh->errorMessage);
  20         &closeSHM($shm);
  21         &closeLog();
  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 pgSQL connection to $param{'SQLHost'}.");
  33     $dbh->disconnect();
  34     return 1;
  35 }
  36
  37 #####
  38 # Usage: &dbQuote($str);
  39 sub dbQuote {
  40     $_[0] =~ s/\'/\\\\'/g;
  41     return "'$_[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 $res = $dbh->exec($query);
  52     if (PGRES_TUPLES_OK ne $res->resultStatus) {
  53         &ERROR("Get: $dbh->errorMessage");
  54         return;
  55     }
  56
  57     if (!$sth->execute) {
  58         &ERROR("Get => '$query'");
  59         &ERROR("Get => $DBI::errstr");
  60         return;
  61     }
  62
  63     my @retval = $res->fetchrow;
  64
  65     if (scalar @retval > 1) {
  66         return @retval;
  67     } elsif (scalar @retval == 1) {
  68         return $retval[0];
  69     } else {
  70         return;
  71     }
  72 }
  73
  74 #####
  75 # Usage: &dbGetCol($table, $primkey, $key, [$type]);
  76 sub dbGetCol {
  77     my ($table, $primkey, $key, $type) = @_;
  78     my $query = "SELECT $primkey,$key FROM $table WHERE $key IS NOT NULL";
  79     my %retval;
  80
  81     my $sth = $dbh->prepare($query);
  82     &ERROR("GetCol => '$query'") unless $sth->execute;
  83
  84     if (defined $type and $type == 1) {
  85         while (my @row = $sth->fetchrow_array) {
  86             # reverse it to make it easier to count.
  87             $retval{$row[1]}{$row[0]} = 1;
  88         }
  89     } else {
  90         while (my @row = $sth->fetchrow_array) {
  91             $retval{$row[0]} = $row[1];
  92         }
  93     }
  94
  95     $sth->finish;
  96
  97     return %retval;
  98 }
  99
 100 #####
 101 # Usage: &dbSet($table, $primkey, $primval, $key, $val);
 102 sub dbSet {
 103     my ($table, $primkey, $primval, $key, $val) = @_;
 104     my $query;
 105
 106     my $result = &dbGet($table,$primkey,$primval,$primkey);
 107     if (defined $result) {
 108         $query = "UPDATE $table SET $key=".&dbQuote($val).
 109                 " WHERE $primkey=".&dbQuote($primval);
 110     } else {
 111         $query = "INSERT INTO $table ($primkey,$key) VALUES (".
 112                 &dbQuote($primval).",".&dbQuote($val).")";
 113     }
 114
 115     &dbRaw("Set", $query);
 116
 117     return 1;
 118 }
 119
 120 #####
 121 # Usage: &dbUpdate($table, $primkey, $primval, $key, $val);
 122 sub dbUpdate {
 123     my ($table, $primkey, $primval, $key, $val) = @_;
 124
 125     &dbRaw("Update", "UPDATE $table SET $key=".&dbQuote($val).
 126                 " WHERE $primkey=".&dbQuote($primval)
 127     );
 128
 129     return 1;
 130 }
 131
 132 #####
 133 # Usage: &dbInsert($table, $primkey, $primval, $key, $val);
 134 sub dbInsert {
 135     my ($table, $primkey, $primval, $key, $val) = @_;
 136
 137     &dbRaw("Insert", "INSERT INTO $table ($primkey,$key) VALUES (".
 138                 &dbQuote($primval).",".&dbQuote($val).")"
 139     );
 140
 141     return 1;
 142 }
 143
 144 #####
 145 # Usage: &dbSetRow($table, @values);
 146 sub dbSetRow {
 147     my ($table, @values) = @_;
 148
 149     foreach (@values) {
 150         $_ = &dbQuote($_);
 151     }
 152
 153     return &dbRaw("SetRow", "INSERT INTO $table VALUES (".
 154         join(",", @values) .")" );
 155 }
 156
 157 #####
 158 # Usage: &dbDel($table, $primkey, $primval, [$key]);
 159 sub dbDel {
 160     my ($table, $primkey, $primval, $key) = @_;
 161
 162     &dbRaw("Del", "DELETE FROM $table WHERE $primkey=".
 163                 &dbQuote($primval)
 164     );
 165
 166     return 1;
 167 }
 168
 169 # Usage: &dbRaw($prefix,$rawquery);
 170 sub dbRaw {
 171     my ($prefix,$query) = @_;
 172     my $sth;
 173
 174     my $res = $dbh->exec($query);
 175     if (PGRES_COMMAND_OK ne $res->resultStatus) {
 176         &ERROR("Raw($prefix): $dbh->errorMessage");
 177         return 0;
 178     }
 179
 180     &DEBUG("Raw: oid status => '$res->oidStatus'.");
 181
 182     if (!$sth->execute) {
 183         &ERROR("Raw($prefix): => '$query'");
 184         &ERROR("Raw($prefix): $DBI::errstr");
 185         return 0;
 186     }
 187
 188     $sth->finish;
 189
 190     return 1;
 191 }
 192
 193 # Usage: &dbRawReturn($rawquery);
 194 sub dbRawReturn {
 195     my ($query) = @_;
 196     my @retval;
 197
 198     my $sth = $dbh->prepare($query);
 199     &ERROR("RawReturn => '$query'.") unless $sth->execute;
 200     while (my @row = $sth->fetchrow_array) {
 201         push(@retval, $row[0]);
 202     }
 203     $sth->finish;
 204
 205     return @retval;
 206 }
 207
 208 ####################################################################
 209 ##### Misc DBI stuff...
 210 #####
 211
 212 #####
 213 # Usage: &countKeys($table);
 214 sub countKeys {
 215     my ($table) = @_;
 216
 217     return (&dbRawReturn("SELECT count(*) FROM $table"))[0];
 218 }
 219
 220 ##### NOT USED.
 221 # Usage: &getKeys($table,$primkey);
 222 sub getKeys {
 223     my ($table,$primkey) = @_;
 224     my @retval;
 225
 226     my $query   = "SELECT $primkey FROM $table";
 227     my $sth     = $dbh->prepare($query);
 228
 229     $sth->execute;
 230     while (my @row = $sth->fetchrow_array) {
 231         push(@retval, $row[0]);
 232     }
 233     $sth->finish;
 234
 235     return @retval;
 236 }
 237
 238 #####
 239 # Usage: &randKey($table, $select);
 240 sub randKey {
 241     my ($table, $select) = @_;
 242     my $rand    = int(rand(&countKeys($table) - 1));
 243     my $query   = "SELECT $select FROM $table LIMIT $rand,1";
 244
 245     my $sth     = $dbh->prepare($query);
 246     $sth->execute;
 247     my @retval  = $sth->fetchrow_array;
 248     $sth->finish;
 249
 250     return @retval;
 251 }
 252
 253 # Usage: &searchTable($table, $select, $key, $str);
 254 sub searchTable {
 255     my($table, $select, $key, $str) = @_;
 256     my $origStr = $str;
 257     my @results;
 258
 259     # allow two types of wildcards.
 260     if ($str =~ /^\^(.*)\$$/) {
 261         &DEBUG("searchTable: should use dbGet(), heh.");
 262         $str = $1;
 263     } else {
 264         $str .= "%"     if ($str =~ s/^\^//);
 265         $str = "%".$str if ($str =~ s/\$$//);
 266         $str = "%".$str."%" if ($str eq $origStr);      # el-cheapo fix.
 267     }
 268
 269     $str =~ s/\_/\\_/g;
 270     $str =~ s/\?/\_/g;  # '.' should be supported, too.
 271     # end of string fix.
 272
 273     my $query = "SELECT $select FROM $table WHERE $key LIKE ".
 274                 &dbQuote($str);
 275     my $sth = $dbh->prepare($query);
 276     $sth->execute;
 277
 278     while (my @row = $sth->fetchrow_array) {
 279         push(@results, $row[0]);
 280     }
 281     $sth->finish;
 282
 283     return @results;
 284 }
 285
 286 ####################################################################
 287 ##### Factoid related stuff...
 288 #####
 289
 290 #####
 291 # Usage: &getFactInfo($faqtoid, [$what]);
 292 sub getFactInfo {
 293     return &dbGet("factoids", "factoid_key", $_[0], $_[1]);
 294 }
 295
 296 #####
 297 # Usage: &getFactoid($faqtoid);
 298 sub getFactoid {
 299     return &getFactInfo($_[0], "factoid_value");
 300 }
 301
 302 #####
 303 # Usage: &setFactInfo($faqtoid, $type, $what);
 304 sub setFactInfo {
 305     &dbSet("factoids", "factoid_key", $_[0], $_[1], $_[2]);
 306 }
 307
 308 sub delFactoid {
 309     my ($faqtoid) = @_;
 310
 311     &dbDel("factoids", "factoid_key",$faqtoid);
 312     &status("DELETED $faqtoid");
 313
 314     return 1;
 315 }
 316
 317 1;