2 # db_pgsql.pl: PostgreSQL database frontend.
4 # Version: v0.2 (20010908)
8 if (&IsParam("useStrict")) { use strict; }
11 # openDB($dbname, $sqluser, $sqlpass, $nofail);
13 my($dbname, $sqluser, $sqlpass, $nofail) = @_;
14 my $connectstr = "dbi:Pg:dbname=$dbname;";
16 if (exists $param{'SQLHost'} and $param{'SQLHost'}) {
17 $hoststr = " to $param{'SQLHost'}";
18 $connectstr .= ";host=$param{SQLHost}";
20 $dbh = DBI->connect($connectstr, $sqluser, $sqlpass);
22 if ($dbh and !$dbh->err) {
23 &status("Opened pgSQL connection$hoststr");
25 &ERROR("cannot connect$hoststr.");
26 &ERROR("pgSQL: ".$dbh->errstr) if ($dbh);
32 return 0 if ($nofail);
39 return 0 unless ($dbh);
41 &status("Closed pgSQL connection.");
48 # Usage: &dbQuote($str);
50 return $dbh->quote($_[0]);
58 # Usage: &dbGet($table, $select, $where);
60 my ($table, $select, $where) = @_;
61 my $query = "SELECT $select FROM $table";
62 $query .= " WHERE $where" if ($where);
64 if (!defined $select) {
65 &WARN("dbGet: select == NULL. table => $table");
70 if (!($sth = $dbh->prepare($query))) {
71 &ERROR("Get: prepare: $DBI::errstr");
77 &ERROR("Get: execute: '$query'");
82 my @retval = $sth->fetchrow_array;
86 if (scalar @retval > 1) {
88 } elsif (scalar @retval == 1) {
96 # Usage: &dbGetCol($table, $select, $where, [$type]);
98 my ($table, $select, $where, $type) = @_;
99 my $query = "SELECT $select FROM $table";
100 $query .= " WHERE ".$where if ($where);
103 my $sth = $dbh->prepare($query);
105 if (!$sth->execute) {
106 &ERROR("GetCol: execute: '$query'");
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]);
116 &DEBUG("dbgetcol: count => ".scalar(keys %retval) );
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;
126 # what to do if there's only one or more than 3?
129 while (my @row = $sth->fetchrow_array) {
130 $retval{$row[0]} = $row[1];
140 # Usage: &dbGetColNiceHash($table, $select, $where);
141 sub dbGetColNiceHash {
142 my ($table, $select, $where) = @_;
144 my $query = "SELECT $select FROM $table";
145 $query .= " WHERE ".$where if ($where);
148 &DEBUG("dbGetColNiceHash: query => '$query'.");
150 my $sth = $dbh->prepare($query);
152 if (!$sth->execute) {
153 &ERROR("GetColNiceHash: execute: '$query'");
154 # &ERROR("GetCol => $DBI::errstr");
159 %retval = %{ $sth->fetchrow_hashref() };
166 # Usage: &dbGetColInfo($table);
170 my $query = "SELECT * FROM $table LIMIT 1;";
171 # my $query = "SHOW COLUMNS from $table";
174 my $sth = $dbh->prepare($query);
176 if (!$sth->execute) {
177 &ERROR("GRI => '$query'");
178 &ERROR("GRI => $DBI::errstr");
183 %retval = %{ $sth->fetchrow_hashref() };
190 # Usage: &dbSet($table, $primhash_ref, $hash_ref);
191 # Note: dbSet does dbQuote.
193 my ($table, $phref, $href) = @_;
194 my $where = join(' AND ', map {
195 $_."=".&dbQuote($phref->{$_})
199 my $result = &dbGet($table, join(',', keys %{$phref}), $where);
202 foreach (keys %{$href}) {
204 push(@vals, &dbQuote($href->{$_}) );
207 if (!@keys or !@vals) {
208 &WARN("dbset: keys or vals is NULL.");
213 if (defined $result) {
215 for(my$i=0; $i<scalar @keys; $i++) {
216 push(@keyval, $keys[$i]."=".$vals[$i] );
219 $query = "UPDATE $table SET ".
220 join(' AND ', @keyval).
223 foreach (keys %{$phref}) {
225 push(@vals, &dbQuote($phref->{$_}) );
228 $query = sprintf("INSERT INTO $table (%s) VALUES (%s)",
229 join(',',@keys), join(',',@vals) );
232 &dbRaw("Set", $query);
238 # Usage: &dbUpdate($table, $primkey, $primval, %hash);
240 my ($table, $primkey, $primval, %hash) = @_;
243 foreach (keys %hash) {
244 push(@array, "$_=".&dbQuote($hash{$_}) );
247 &dbRaw("Update", "UPDATE $table SET ".join(', ', @array).
248 " WHERE $primkey=".&dbQuote($primval)
255 # Usage: &dbInsert($table, $primkey, $primval, %hash);
257 my ($table, $primkey, $primval, %hash) = @_;
260 foreach (keys %hash) {
262 push(@vals, &dbQuote($hash{$_}));
265 &dbRaw("Insert($table)", "INSERT INTO $table (".join(',',@keys).
266 ") VALUES (".join(',',@vals).")"
273 # Usage: &dbReplace($table, $key, %hash);
274 # Note: dbReplace does optional dbQuote.
276 my ($table, $key, %hash) = @_;
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 ";
283 foreach (keys %hash) {
284 if (s/^-//) { # as is.
286 push(@vals, $hash{'-'.$_});
289 push(@vals, &dbQuote($hash{$_}));
291 $uquery .= "$keys[-1] = $vals[-1], ";
293 $uquery =~ s/, $/ $where;/;
294 $iquery .= "(". join(',',@keys) .") VALUES (". join(',',@vals) .");";
296 &DEBUG($squery) if (0);
298 if(&dbRawReturn($squery)) {
299 &dbRaw("Replace($table)", $uquery);
301 &dbRaw("Replace($table)", $iquery);
308 ##### MADE REDUNDANT BY LEAR.
309 # Usage: &dbSetRow($table, $vref, $delay);
310 # Note: dbSetRow does dbQuote.
312 my ($table, $vref, $delay) = @_;
313 my $p = ($delay) ? " DELAYED " : "";
315 # see 'perldoc perlreftut'
317 foreach (@{ $vref }) {
318 push(@values, &dbQuote($_) );
321 if (!scalar @values) {
322 &WARN("dbSetRow: values array == NULL.");
326 return &dbRaw("SetRow", "INSERT $p INTO $table VALUES (".
327 join(",", @values) .")" );
331 # Usage: &dbDel($table, $primkey, $primval, [$key]);
332 # Note: dbDel does dbQuote
334 my ($table, $primkey, $primval, $key) = @_;
336 &dbRaw("Del", "DELETE FROM $table WHERE $primkey=".
343 # Usage: &dbRaw($prefix,$rawquery);
345 my ($prefix,$query) = @_;
348 if (!($sth = $dbh->prepare($query))) {
349 &ERROR("Raw($prefix): $DBI::errstr");
354 if (!$sth->execute) {
355 &ERROR("Raw($prefix): => '$query'");
365 # Usage: &dbRawReturn($rawquery);
370 my $sth = $dbh->prepare($query);
372 &ERROR("RawReturn => '$query'.") unless $sth->execute;
373 while (my @row = $sth->fetchrow_array) {
374 push(@retval, $row[0]);
381 ####################################################################
382 ##### Misc DBI stuff...
386 # Usage: &countKeys($table, [$col]);
388 my ($table, $col) = @_;
391 return (&dbRawReturn("SELECT count($col) FROM $table"))[0];
394 # Usage: &sumKey($table, $col);
396 my ($table, $col) = @_;
398 return (&dbRawReturn("SELECT sum($col) FROM $table"))[0];
402 # Usage: &randKey($table, $select);
404 my ($table, $select) = @_;
405 my $rand = int(rand(&countKeys($table) - 1));
406 my $query = "SELECT $select FROM $table LIMIT 1,$rand";
408 my $sth = $dbh->prepare($query);
410 &WARN("randKey($query)") unless $sth->execute;
411 my @retval = $sth->fetchrow_array;
418 # Usage: &deleteTable($table);
420 &dbRaw("deleteTable($_[0])", "DELETE FROM $_[0]");
424 # Usage: &searchTable($table, $select, $key, $str);
425 # Note: searchTable does dbQuote.
427 my($table, $select, $key, $str) = @_;
431 # allow two types of wildcards.
432 if ($str =~ /^\^(.*)\$$/) {
433 &DEBUG("searchTable: should use dbGet(), heh.");
436 $str .= "%" if ($str =~ s/^\^//);
437 $str = "%".$str if ($str =~ s/\$$//);
438 $str = "%".$str."%" if ($str eq $origStr); # el-cheapo fix.
442 $str =~ s/\?/\_/g; # '.' should be supported, too.
445 my $query = "SELECT $select FROM $table WHERE $key LIKE ".
447 my $sth = $dbh->prepare($query);
449 if (!$sth->execute) {
450 &WARN("Search($query)");
454 while (my @row = $sth->fetchrow_array) {
455 push(@results, $row[0]);
465 &FIXME("pgsql: checkTables(@_);");