2 # db_pgsql.pl: PostgreSQL database frontend.
3 # Author: dms <dms@users.sourceforge.net>
4 # Version: v0.1 (20000629)
8 if (&IsParam("useStrict")) { use strict; }
11 $dbh = Pg::connectdb("dbname=$param{'DBName'}");
12 # $dbh = Pg::setdbLogin($param{'SQLHost'}, , , , $param{'DBName'},
13 # $param{'SQLUser'}, $param{'SQLPass'});
15 if (PGRES_CONNECTION_OK eq $dbh->status) {
16 &status("Opened pgSQL connection to $param{'SQLHost'}");
18 &ERROR("cannot connect to $param{'SQLHost'}.");
19 &ERROR("pgSQL: ".$dbh->errorMessage);
28 &WARN("closeDB: connection already closed?");
32 &status("Closed pgSQL connection to $param{'SQLHost'}.");
38 # Usage: &dbQuote($str);
40 $_[0] =~ s/\'/\\\\'/g;
45 # Usage: &dbGet($table, $primkey, $primval, $select);
47 my ($table, $primkey, $primval, $select) = @_;
48 my $query = "SELECT $select FROM $table WHERE $primkey=".
51 my $res = $dbh->exec($query);
52 if (PGRES_TUPLES_OK ne $res->resultStatus) {
53 &ERROR("Get: $dbh->errorMessage");
58 &ERROR("Get => '$query'");
59 &ERROR("Get => $DBI::errstr");
63 my @retval = $res->fetchrow;
65 if (scalar @retval > 1) {
67 } elsif (scalar @retval == 1) {
75 # Usage: &dbGetCol($table, $primkey, $key, [$type]);
77 my ($table, $primkey, $key, $type) = @_;
78 my $query = "SELECT $primkey,$key FROM $table WHERE $key IS NOT NULL";
81 my $sth = $dbh->prepare($query);
82 &ERROR("GetCol => '$query'") unless $sth->execute;
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;
90 while (my @row = $sth->fetchrow_array) {
91 $retval{$row[0]} = $row[1];
101 # Usage: &dbSet($table, $primkey, $primval, $key, $val);
103 my ($table, $primkey, $primval, $key, $val) = @_;
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);
111 $query = "INSERT INTO $table ($primkey,$key) VALUES (".
112 &dbQuote($primval).",".&dbQuote($val).")";
115 &dbRaw("Set", $query);
121 # Usage: &dbUpdate($table, $primkey, $primval, $key, $val);
123 my ($table, $primkey, $primval, $key, $val) = @_;
125 &dbRaw("Update", "UPDATE $table SET $key=".&dbQuote($val).
126 " WHERE $primkey=".&dbQuote($primval)
133 # Usage: &dbInsert($table, $primkey, $primval, $key, $val);
135 my ($table, $primkey, $primval, $key, $val) = @_;
137 &dbRaw("Insert", "INSERT INTO $table ($primkey,$key) VALUES (".
138 &dbQuote($primval).",".&dbQuote($val).")"
145 # Usage: &dbSetRow($table, @values);
147 my ($table, @values) = @_;
153 return &dbRaw("SetRow", "INSERT INTO $table VALUES (".
154 join(",", @values) .")" );
158 # Usage: &dbDel($table, $primkey, $primval, [$key]);
160 my ($table, $primkey, $primval, $key) = @_;
162 &dbRaw("Del", "DELETE FROM $table WHERE $primkey=".
169 # Usage: &dbRaw($prefix,$rawquery);
171 my ($prefix,$query) = @_;
174 my $res = $dbh->exec($query);
175 if (PGRES_COMMAND_OK ne $res->resultStatus) {
176 &ERROR("Raw($prefix): $dbh->errorMessage");
180 &DEBUG("Raw: oid status => '$res->oidStatus'.");
182 if (!$sth->execute) {
183 &ERROR("Raw($prefix): => '$query'");
184 &ERROR("Raw($prefix): $DBI::errstr");
193 # Usage: &dbRawReturn($rawquery);
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]);
208 ####################################################################
209 ##### Misc DBI stuff...
213 # Usage: &countKeys($table);
217 return (&dbRawReturn("SELECT count(*) FROM $table"))[0];
221 # Usage: &getKeys($table,$primkey);
223 my ($table,$primkey) = @_;
226 my $query = "SELECT $primkey FROM $table";
227 my $sth = $dbh->prepare($query);
230 while (my @row = $sth->fetchrow_array) {
231 push(@retval, $row[0]);
239 # Usage: &randKey($table, $select);
241 my ($table, $select) = @_;
242 my $rand = int(rand(&countKeys($table) - 1));
243 my $query = "SELECT $select FROM $table LIMIT $rand,1";
245 my $sth = $dbh->prepare($query);
247 my @retval = $sth->fetchrow_array;
253 # Usage: &searchTable($table, $select, $key, $str);
255 my($table, $select, $key, $str) = @_;
259 # allow two types of wildcards.
260 if ($str =~ /^\^(.*)\$$/) {
261 &DEBUG("searchTable: should use dbGet(), heh.");
264 $str .= "%" if ($str =~ s/^\^//);
265 $str = "%".$str if ($str =~ s/\$$//);
266 $str = "%".$str."%" if ($str eq $origStr); # el-cheapo fix.
270 $str =~ s/\?/\_/g; # '.' should be supported, too.
273 my $query = "SELECT $select FROM $table WHERE $key LIKE ".
275 my $sth = $dbh->prepare($query);
278 while (my @row = $sth->fetchrow_array) {
279 push(@results, $row[0]);
286 ####################################################################
287 ##### Factoid related stuff...
291 # Usage: &getFactInfo($faqtoid, [$what]);
293 return &dbGet("factoids", "factoid_key", $_[0], $_[1]);
297 # Usage: &getFactoid($faqtoid);
299 return &getFactInfo($_[0], "factoid_value");
303 # Usage: &setFactInfo($faqtoid, $type, $what);
305 &dbSet("factoids", "factoid_key", $_[0], $_[1], $_[2]);
311 &dbDel("factoids", "factoid_key",$faqtoid);
312 &status("DELETED $faqtoid");