From 56c7fbbf7decf9793b7ff8582a6140bead8f472c Mon Sep 17 00:00:00 2001 From: dms Date: Thu, 21 Nov 2002 13:21:31 +0000 Subject: [PATCH] - unify db_mysql and db_pgsql (thus remove db_pgsql.pl) into dbi.pl - rename db_dbm.pl to dbm.pl git-svn-id: https://svn.code.sf.net/p/infobot/code/trunk@652 c11ca15a-4712-0410-83d8-924469b57eb5 --- blootbot/src/db_pgsql.pl | 469 --------------------------- blootbot/src/{db_mysql.pl => dbi.pl} | 132 +++++--- blootbot/src/{db_dbm.pl => dbm.pl} | 111 ++++--- 3 files changed, 136 insertions(+), 576 deletions(-) delete mode 100644 blootbot/src/db_pgsql.pl rename blootbot/src/{db_mysql.pl => dbi.pl} (79%) rename blootbot/src/{db_dbm.pl => dbm.pl} (74%) diff --git a/blootbot/src/db_pgsql.pl b/blootbot/src/db_pgsql.pl deleted file mode 100644 index f7d91ae..0000000 --- a/blootbot/src/db_pgsql.pl +++ /dev/null @@ -1,469 +0,0 @@ -# -# db_pgsql.pl: PostgreSQL database frontend. -# Author: dms -# Version: v0.2 (20010908) -# Created: 20000629 -# - -if (&IsParam("useStrict")) { use strict; } - -##### -# openDB($dbname, $sqluser, $sqlpass, $nofail); -sub openDB { - my($dbname, $sqluser, $sqlpass, $nofail) = @_; - my $connectstr = "dbi:Pg:dbname=$dbname;"; - my $hoststr = ""; - if (exists $param{'SQLHost'} and $param{'SQLHost'}) { - $hoststr = " to $param{'SQLHost'}"; - $connectstr .= ";host=$param{SQLHost}"; - } - $dbh = DBI->connect($connectstr, $sqluser, $sqlpass); - - if ($dbh and !$dbh->err) { - &status("Opened pgSQL connection$hoststr"); - } else { - &ERROR("cannot connect$hoststr."); - &ERROR("pgSQL: ".$dbh->errstr) if ($dbh); - - &closePID(); - &closeSHM($shm); - &closeLog(); - - return 0 if ($nofail); - - exit 1; - } -} - -sub closeDB { - return 0 unless ($dbh); - - &status("Closed pgSQL connection."); - $dbh->disconnect(); - - return 1; -} - -##### -# Usage: &dbQuote($str); -sub dbQuote { - return $dbh->quote($_[0]); - - $_ = $_[0]; - s/'/\\'/g; - return "'$_'"; -} - -##### -# Usage: &dbGet($table, $select, $where); -sub dbGet { - my ($table, $select, $where) = @_; - my $query = "SELECT $select FROM $table"; - $query .= " WHERE $where" if ($where); - - if (!defined $select) { - &WARN("dbGet: select == NULL. table => $table"); - return; - } - - my $sth; - if (!($sth = $dbh->prepare($query))) { - &ERROR("Get: prepare: $DBI::errstr"); - return; - } - - &SQLDebug($query); - if (!$sth->execute) { - &ERROR("Get: execute: '$query'"); - $sth->finish; - return 0; - } - - my @retval = $sth->fetchrow_array; - - $sth->finish; - - if (scalar @retval > 1) { - return @retval; - } elsif (scalar @retval == 1) { - return $retval[0]; - } else { - return; - } -} - -##### -# Usage: &dbGetCol($table, $select, $where, [$type]); -sub dbGetCol { - my ($table, $select, $where, $type) = @_; - my $query = "SELECT $select FROM $table"; - $query .= " WHERE ".$where if ($where); - my %retval; - - my $sth = $dbh->prepare($query); - &SQLDebug($query); - if (!$sth->execute) { - &ERROR("GetCol: execute: '$query'"); - $sth->finish; - return; - } - - if (defined $type and $type == 2) { - &DEBUG("dbgetcol: type 2!"); - while (my @row = $sth->fetchrow_array) { - $retval{$row[0]} = join(':', $row[1..$#row]); - } - &DEBUG("dbgetcol: count => ".scalar(keys %retval) ); - - } elsif (defined $type and $type == 1) { - while (my @row = $sth->fetchrow_array) { - # reverse it to make it easier to count. - if (scalar @row == 2) { - $retval{$row[1]}{$row[0]} = 1; - } elsif (scalar @row == 3) { - $retval{$row[1]}{$row[0]} = 1; - } - # what to do if there's only one or more than 3? - } - } else { - while (my @row = $sth->fetchrow_array) { - $retval{$row[0]} = $row[1]; - } - } - - $sth->finish; - - return %retval; -} - -##### -# Usage: &dbGetColNiceHash($table, $select, $where); -sub dbGetColNiceHash { - my ($table, $select, $where) = @_; - $select ||= "*"; - my $query = "SELECT $select FROM $table"; - $query .= " WHERE ".$where if ($where); - my %retval; - - &DEBUG("dbGetColNiceHash: query => '$query'."); - - my $sth = $dbh->prepare($query); - &SQLDebug($query); - if (!$sth->execute) { - &ERROR("GetColNiceHash: execute: '$query'"); -# &ERROR("GetCol => $DBI::errstr"); - $sth->finish; - return; - } - - %retval = %{ $sth->fetchrow_hashref() }; - $sth->finish; - - return %retval; -} - -#### -# Usage: &dbGetColInfo($table); -sub dbGetColInfo { - my ($table) = @_; - - my $query = "SELECT * FROM $table LIMIT 1;"; -# my $query = "SHOW COLUMNS from $table"; - my %retval; - - my $sth = $dbh->prepare($query); - &SQLDebug($query); - if (!$sth->execute) { - &ERROR("GRI => '$query'"); - &ERROR("GRI => $DBI::errstr"); - $sth->finish; - return; - } - - %retval = %{ $sth->fetchrow_hashref() }; - $sth->finish; - - return keys %retval; -} - -##### -# Usage: &dbSet($table, $primhash_ref, $hash_ref); -# Note: dbSet does dbQuote. -sub dbSet { - my ($table, $phref, $href) = @_; - my $where = join(' AND ', map { - $_."=".&dbQuote($phref->{$_}) - } keys %{$phref} - ); - - my $result = &dbGet($table, join(',', keys %{$phref}), $where); - - my(@keys,@vals); - foreach (keys %{$href}) { - push(@keys, $_); - push(@vals, &dbQuote($href->{$_}) ); - } - - if (!@keys or !@vals) { - &WARN("dbset: keys or vals is NULL."); - return; - } - - my $query; - if (defined $result) { - my @keyval; - for(my$i=0; $i{$_}) ); - } - - $query = sprintf("INSERT INTO $table (%s) VALUES (%s)", - join(',',@keys), join(',',@vals) ); - } - - &dbRaw("Set", $query); - - return 1; -} - -##### -# Usage: &dbUpdate($table, $primkey, $primval, %hash); -sub dbUpdate { - my ($table, $primkey, $primval, %hash) = @_; - my (@array); - - foreach (keys %hash) { - push(@array, "$_=".&dbQuote($hash{$_}) ); - } - - &dbRaw("Update", "UPDATE $table SET ".join(', ', @array). - " WHERE $primkey=".&dbQuote($primval) - ); - - return 1; -} - -##### -# Usage: &dbInsert($table, $primkey, $primval, %hash); -sub dbInsert { - my ($table, $primkey, $primval, %hash) = @_; - my (@keys, @vals); - - foreach (keys %hash) { - push(@keys, $_); - push(@vals, &dbQuote($hash{$_})); - } - - &dbRaw("Insert($table)", "INSERT INTO $table (".join(',',@keys). - ") VALUES (".join(',',@vals).")" - ); - - return 1; -} - -##### -# Usage: &dbReplace($table, $key, %hash); -# Note: dbReplace does optional dbQuote. -sub dbReplace { - my ($table, $key, %hash) = @_; - my (@keys, @vals); - my $where = "WHERE $key=".&dbQuote($hash{$key}); - my $squery = "SELECT $key FROM $table $where;"; - my $iquery = "INSERT INTO $table "; - my $uquery = "UPDATE $table SET "; - - foreach (keys %hash) { - if (s/^-//) { # as is. - push(@keys, $_); - push(@vals, $hash{'-'.$_}); - } else { - push(@keys, $_); - push(@vals, &dbQuote($hash{$_})); - } - $uquery .= "$keys[-1] = $vals[-1], "; - } - $uquery =~ s/, $/ $where;/; - $iquery .= "(". join(',',@keys) .") VALUES (". join(',',@vals) .");"; - - &DEBUG($squery) if (0); - - if(&dbRawReturn($squery)) { - &dbRaw("Replace($table)", $uquery); - } else { - &dbRaw("Replace($table)", $iquery); - } - - - return 1; -} - -##### MADE REDUNDANT BY LEAR. -# Usage: &dbSetRow($table, $vref, $delay); -# Note: dbSetRow does dbQuote. -sub dbSetRow ($@$) { - my ($table, $vref, $delay) = @_; - my $p = ($delay) ? " DELAYED " : ""; - - # see 'perldoc perlreftut' - my @values; - foreach (@{ $vref }) { - push(@values, &dbQuote($_) ); - } - - if (!scalar @values) { - &WARN("dbSetRow: values array == NULL."); - return; - } - - return &dbRaw("SetRow", "INSERT $p INTO $table VALUES (". - join(",", @values) .")" ); -} - -##### -# Usage: &dbDel($table, $primkey, $primval, [$key]); -# Note: dbDel does dbQuote -sub dbDel { - my ($table, $primkey, $primval, $key) = @_; - - &dbRaw("Del", "DELETE FROM $table WHERE $primkey=". - &dbQuote($primval) - ); - - return 1; -} - -# Usage: &dbRaw($prefix,$rawquery); -sub dbRaw { - my ($prefix,$query) = @_; - my $sth; - - if (!($sth = $dbh->prepare($query))) { - &ERROR("Raw($prefix): $DBI::errstr"); - return 0; - } - - &SQLDebug($query); - if (!$sth->execute) { - &ERROR("Raw($prefix): => '$query'"); - $sth->finish; - return 0; - } - - $sth->finish; - - return 1; -} - -# Usage: &dbRawReturn($rawquery); -sub dbRawReturn { - my ($query) = @_; - my @retval; - - my $sth = $dbh->prepare($query); - &SQLDebug($query); - &ERROR("RawReturn => '$query'.") unless $sth->execute; - while (my @row = $sth->fetchrow_array) { - push(@retval, $row[0]); - } - $sth->finish; - - return @retval; -} - -#################################################################### -##### Misc DBI stuff... -##### - -##### -# Usage: &countKeys($table, [$col]); -sub countKeys { - my ($table, $col) = @_; - $col ||= "*"; - - return (&dbRawReturn("SELECT count($col) FROM $table"))[0]; -} - -# Usage: &sumKey($table, $col); -sub sumKey { - my ($table, $col) = @_; - - return (&dbRawReturn("SELECT sum($col) FROM $table"))[0]; -} - -##### -# Usage: &randKey($table, $select); -sub randKey { - my ($table, $select) = @_; - my $rand = int(rand(&countKeys($table) - 1)); - my $query = "SELECT $select FROM $table LIMIT 1,$rand"; - - my $sth = $dbh->prepare($query); - &SQLDebug($query); - &WARN("randKey($query)") unless $sth->execute; - my @retval = $sth->fetchrow_array; - $sth->finish; - - return @retval; -} - -##### -# Usage: &deleteTable($table); -sub deleteTable { - &dbRaw("deleteTable($_[0])", "DELETE FROM $_[0]"); -} - -##### -# Usage: &searchTable($table, $select, $key, $str); -# Note: searchTable does dbQuote. -sub searchTable { - my($table, $select, $key, $str) = @_; - my $origStr = $str; - my @results; - - # allow two types of wildcards. - if ($str =~ /^\^(.*)\$$/) { - &DEBUG("searchTable: should use dbGet(), heh."); - $str = $1; - } else { - $str .= "%" if ($str =~ s/^\^//); - $str = "%".$str if ($str =~ s/\$$//); - $str = "%".$str."%" if ($str eq $origStr); # el-cheapo fix. - } - - $str =~ s/\_/\\_/g; - $str =~ s/\?/\_/g; # '.' should be supported, too. - # end of string fix. - - my $query = "SELECT $select FROM $table WHERE $key LIKE ". - &dbQuote($str); - my $sth = $dbh->prepare($query); - &SQLDebug($query); - if (!$sth->execute) { - &WARN("Search($query)"); - return; - } - - while (my @row = $sth->fetchrow_array) { - push(@results, $row[0]); - } - $sth->finish; - - return @results; -} - -##### -# -sub checkTables { - &FIXME("pgsql: checkTables(@_);"); - return 1; -} - -1; diff --git a/blootbot/src/db_mysql.pl b/blootbot/src/dbi.pl similarity index 79% rename from blootbot/src/db_mysql.pl rename to blootbot/src/dbi.pl index 3343235..8d38b6a 100644 --- a/blootbot/src/db_mysql.pl +++ b/blootbot/src/dbi.pl @@ -1,36 +1,50 @@ # -# db_mysql.pl: MySQL database frontend. -# Author: dms -# Version: v0.2c (19991224) -# Created: 19991203 +# dbi.pl: DBI (mysql/pgsql/sqlite) database frontend. +# Author: dms +# Version: v0.2c (19991224) +# Created: 19991203 +# Notes: based on db_mysql.pl # -package main; +use strict; + +use vars qw(%param); +use vars qw($dbh $shm $bot_data_dir); -if (&IsParam("useStrict")) { use strict; } +package main; ##### -# &openDB($dbname, $sqluser, $sqlpass, $nofail); +# &openDB($dbname, $dbtype, $sqluser, $sqlpass, $nofail); sub openDB { - my ($db, $user, $pass, $no_fail) = @_; - my $dsn = "DBI:mysql:$db"; + my ($db, $type, $user, $pass, $no_fail) = @_; + # this is a mess. someone fix it, please. + if ($type =~ /^SQLite$/i) { + $db = "dbname=$db.sqlite"; + } elsif ($type =~ /^pg/i) { + $db = "dbname=$db"; + $type = "Pg"; + } + + my $dsn = "DBI:$type:$db"; my $hoststr = ""; + # does sqlite support remote servers? if (exists $param{'SQLHost'} and $param{'SQLHost'}) { $dsn .= ":$param{SQLHost}"; $hoststr = " to $param{'SQLHost'}"; } $dbh = DBI->connect($dsn, $user, $pass); - if ($dbh) { - &status("Opened MySQL connection$hoststr"); + if ($dbh && !$dbh->err) { + &status("Opened $type connection$hoststr"); } else { &ERROR("cannot connect$hoststr."); - &ERROR("since mysql is not available, shutting down bot!"); + &ERROR("since $type is not available, shutting down bot!"); + &ERROR( $dbh->errstr ) if ($dbh); &closePID(); &closeSHM($shm); &closeLog(); - return if ($no_fail); + return 0 if ($no_fail); exit 1; } @@ -39,10 +53,10 @@ sub openDB { sub closeDB { return 0 unless ($dbh); - my $hoststr = ""; - $hoststr = " to $param{'SQLHost'}" if (exists $param{'SQLHost'}); + my $x = $param{SQLHost}; + my $hoststr = ($x) ? " to $x" : ""; - &status("Closed MySQL connection$hoststr."); + &status("Closed DBI connection$hoststr."); $dbh->disconnect(); return 1; @@ -173,6 +187,10 @@ sub dbGetColInfo { my ($table) = @_; my $query = "SHOW COLUMNS from $table"; + if ($param{DBType} =~ /^pg/i) { + $query = "SELECT * FROM $table LIMIT 1"; + } + my %retval; my $sth = $dbh->prepare($query); @@ -289,7 +307,7 @@ sub dbInsert { foreach (keys %hash) { push(@keys, $_); - push(@vals, &dbQuote($hash{$_})); + push(@vals, &dbQuote( $hash{$_} )); } &dbRaw("Insert($table)", "INSERT $p INTO $table (".join(',',@keys). @@ -316,11 +334,8 @@ sub dbReplace { } } - if (0) { - &DEBUG("REPLACE INTO $table (".join(',',@keys). - ") VALUES (". join(',',@vals). ")" ); - } - + # hrm... does pgsql support REPLACE? + # if not, well... fuck it. &dbRaw("Replace($table)", "REPLACE INTO $table (".join(',',@keys). ") VALUES (". join(',',@vals). ")" ); @@ -369,16 +384,13 @@ sub dbRaw { my $sth; if (!($sth = $dbh->prepare($query))) { - &ERROR("Raw($prefix): $DBI::errstr"); + &ERROR("Raw($prefix): !prepare => '$query'"); return 0; } -# &DEBUG("query => '$query'."); - &SQLDebug($query); if (!$sth->execute) { - &ERROR("Raw($prefix): => '$query'"); - # $DBI::errstr is printed as warning automatically. + &ERROR("Raw($prefix): !execute => '$query'"); $sth->finish; return 0; } @@ -395,6 +407,8 @@ sub dbRawReturn { my $sth = $dbh->prepare($query); &SQLDebug($query); + # what happens when it can't execute it? does it throw heaps more + # error lines? if so. follow dbRaw()'s style. &ERROR("RawReturn => '$query'.") unless $sth->execute; while (my @row = $sth->fetchrow_array) { push(@retval, $row[0]); @@ -413,10 +427,12 @@ sub dbRawReturn { sub countKeys { my ($table, $col) = @_; $col ||= "*"; + &DEBUG("&countKeys($table, $col);"); return (&dbRawReturn("SELECT count($col) FROM $table"))[0]; } +##### # Usage: &sumKey($table, $col); sub sumKey { my ($table, $col) = @_; @@ -430,6 +446,9 @@ sub randKey { my ($table, $select) = @_; my $rand = int(rand(&countKeys($table) - 1)); my $query = "SELECT $select FROM $table LIMIT $rand,1"; + if ($param{DBType} =~ /^pg/i) { + $query =~ s/$rand,1/1,$rand/; + } my $sth = $dbh->prepare($query); &SQLDebug($query); @@ -466,7 +485,7 @@ sub searchTable { $str =~ s/\_/\\_/g; $str =~ s/\?/_/g; # '.' should be supported, too. - $str =~ s/\*/%/g; # for mysql. + $str =~ s/\*/%/g; # end of string fix. my $query = "SELECT $select FROM $table WHERE $key LIKE ". @@ -476,6 +495,7 @@ sub searchTable { &SQLDebug($query); if (!$sth->execute) { &WARN("Search($query)"); + $sth->finish; return; } @@ -495,7 +515,7 @@ sub dbCreateTable { foreach (@path) { my $file = "$_/setup/$table.sql"; - &DEBUG("dbCT: file => $file"); + &DEBUG("dbCT: table => '$table', file => '$file'"); next unless ( -f $file ); &DEBUG("dbCT: found!!!"); @@ -513,40 +533,50 @@ sub dbCreateTable { if (!$found) { return 0; } else { - &dbRaw("createTable($table)", $data); + &dbRaw("dbcreateTable($table)", $data); return 1; } } sub checkTables { my $database_exists = 0; - foreach ( &dbRawReturn("SHOW DATABASES") ) { - $database_exists++ if ($_ eq $param{'DBName'}); - } + my %db; - unless ($database_exists) { - &status("Creating database $param{DBName}..."); - $query = "CREATE DATABASE $param{DBName}"; - &dbRaw("create(db $param{DBName})", $query); - } + if ($param{DBType} =~ /^mysql$/i) { + my $sql = "SHOW DATABASES"; + foreach ( &dbRawReturn($sql) ) { + $database_exists++ if ($_ eq $param{'DBName'}); + } - # retrieve a list of db's from the server. - my %db; - foreach ($dbh->func('_ListTables')) { - $db{$_} = 1; - } + unless ($database_exists) { + &status("Creating database $param{DBName}..."); + my $query = "CREATE DATABASE $param{DBName}"; + &dbRaw("create(db $param{DBName})", $query); + } - # create database. - if (!scalar keys %db) { -# &status("Creating database $param{'DBName'}..."); -# $query = "CREATE DATABASE $param{'DBName'}"; -# &dbRaw("create(db $param{'DBName'})", $query); + # retrieve a list of db's from the server. + foreach ($dbh->func('_ListTables')) { + $db{$_} = 1; + } + + } elsif ($param{DBType} =~ /^SQLite$/i) { + + # retrieve a list of db's from the server. + foreach ( &dbRawReturn("SELECT name FROM sqlite_master WHERE type='table'") ) { + $db{$_} = 1; + } + + # create database. + if (!scalar keys %db) { + &status("Creating database $param{'DBName'}..."); + my $query = "CREATE DATABASE $param{'DBName'}"; + &dbRaw("create(db $param{'DBName'})", $query); + } } - foreach ("factoids", "freshmeat", "rootwarn", "seen", "stats", - ) { + foreach ( qw(factoids freshmeat rootwarn seen stats) ) { next if (exists $db{$_}); - &status(" creating new table $_..."); + &status("checkTables: creating new table $_..."); &dbCreateTable($_); } diff --git a/blootbot/src/db_dbm.pl b/blootbot/src/dbm.pl similarity index 74% rename from blootbot/src/db_dbm.pl rename to blootbot/src/dbm.pl index d702d9e..b5067b6 100644 --- a/blootbot/src/db_dbm.pl +++ b/blootbot/src/dbm.pl @@ -1,16 +1,16 @@ # -# db_dbm.pl: Extension on the factoid database. +# dbm.pl: Extension on the factoid database. # OrigAuthor: Kevin Lenzo (c) 1997 # CurrAuthor: dms # Version: v0.6 (20000707) # FModified: 19991020 # -#package main; +use strict; -if (&::IsParam('useStrict')) { use strict;} +package main; -use vars qw(%factoids %freshmeat %seen %rootwarn); # db hash. +use vars qw(%factoids %param); { my %formats = ( @@ -60,33 +60,31 @@ use vars qw(%factoids %freshmeat %seen %rootwarn); # db hash. ); sub openDB { - my ($dbname) = @_; use DB_File; - foreach $table (keys %formats) { - my $file = "$dbname-$table"; - if (&::IsParam($table)) { - if (dbmopen(%{ $table }, $file, 0666)) { - &::status("Opened DBM $table ($file)."); - } else { - &::ERROR("Failed open to DBM $table ($file)."); - &::shutdown(); - exit 1; - } + foreach (keys %formats) { + next unless (&IsParam($_)); + + my $file = "$param{'DBName'}-$_"; + + if (dbmopen(%{ $_ }, $file, 0666)) { + &status("Opened DBM $_ ($file)."); } else { - &::status("DBM $table ($file) disabled."); + &ERROR("Failed open to DBM $_ ($file)."); + &shutdown(); + exit 1; } } } sub closeDB { foreach (keys %formats) { - next unless (&::IsParam($_)); + next unless (&IsParam($_)); if (dbmclose(%{ $_ })) { - &::status("Closed DBM $_ successfully."); + &status("Closed DBM $_ successfully."); next; } - &::ERROR("Failed closing DBM $_."); + &ERROR("Failed closing DBM $_."); } } @@ -98,7 +96,7 @@ use vars qw(%factoids %freshmeat %seen %rootwarn); # db hash. if (scalar @{$formats{$table}}) { return @{$formats{$table}}; } else { - &::ERROR("dbGCI: no format for table ($table)."); + &ERROR("dbGCI: no format for table ($table)."); return; } } @@ -118,7 +116,7 @@ sub dbGet { my $found = 0; my @retval; my $i; - &::DEBUG("dbGet($table, $select, $where);"); + &DEBUG("dbGet($table, $select, $where);"); return unless $key; my @format = &dbGetColInfo($table); @@ -127,7 +125,7 @@ sub dbGet { } if (!defined ${ "$table" }{lc $val}) { # dbm hash exception. - &::DEBUG("dbGet: '$val' does not exist in $table."); + &DEBUG("dbGet: '$val' does not exist in $table."); return; } @@ -138,14 +136,14 @@ sub dbGet { return(@retval); } - &::DEBUG("dbGet: select=>'$select'."); + &DEBUG("dbGet: select=>'$select'."); my @array = split "$;", ${"$table"}{lc $val}; unshift(@array,$val); for (0 .. $#format) { my $str = $format[$_]; next unless (grep /^$str$/, split(/\,/, $select)); $array[$_] ||= ''; - &::DEBUG("dG: '$format[$_]'=>'$array[$_]'."); + &DEBUG("dG: '$format[$_]'=>'$array[$_]'."); push(@retval, $array[$_]); } @@ -163,14 +161,14 @@ sub dbGet { # Usage: &dbGetCol($table, $select, $where, [$type]); sub dbGetCol { my ($table, $select, $where, $type) = @_; - &::FIXME("STUB: &dbGetCol($table, $select, $where, $type);"); + &FIXME("STUB: &dbGetCol($table, $select, $where, $type);"); } ##### # Usage: &dbGetColNiceHash($table, $select, $where); sub dbGetColNiceHash { my ($table, $select, $where) = @_; - &::DEBUG("dbGetColNiceHash($table, $select, $where);"); + &DEBUG("dbGetColNiceHash($table, $select, $where);"); my ($key, $val) = split('=',$where) if $where =~ /=/; return unless ${$table}{lc $val}; my (%hash) = (); @@ -187,7 +185,7 @@ sub dbGetColNiceHash { sub dbInsert { my ($table, $primkey, %hash) = @_; my $found = 0; - &::DEBUG("dbInsert($table, $primkey, ...)"); + &DEBUG("dbInsert($table, $primkey, ...)"); my $info = ${$table}{lc $primkey} || ''; # primkey or primval? @@ -204,13 +202,13 @@ sub dbInsert { $array[$i - 1]=$hash{$col}; $array[$i - 1]='' unless $array[$i - 1]; delete $hash{$col}; - &::DEBUG("dbI: '$col'=>'$array[$i - 1]'"); + &DEBUG("dbI: '$col'=>'$array[$i - 1]'"); } if (scalar keys %hash) { - &::ERROR("dbI: not added..."); + &ERROR("dbI: not added..."); foreach (keys %hash) { - &::ERROR("dbI: '$_'=>'$hash{$_}'"); + &ERROR("dbI: '$_'=>'$hash{$_}'"); } return 0; } @@ -221,14 +219,14 @@ sub dbInsert { } sub dbUpdate { - &::FIXME("STUB: &dbUpdate(@_);=>somehow use dbInsert!"); + &FIXME("STUB: &dbUpdate(@_);=>somehow use dbInsert!"); } ##### # Usage: &dbSetRow($table, @values); sub dbSetRow { my ($table, @values) = @_; - &::DEBUG("dbSetRow(@_);"); + &DEBUG("dbSetRow(@_);"); my $key = lc $values[0]; my @format = &dbGetColInfo($table); @@ -237,16 +235,17 @@ sub dbSetRow { } if (defined ${$table}{$key}) { - &::WARN("dbSetRow: $table {$key} already exists?"); + &WARN("dbSetRow: $table {$key} already exists?"); } if (scalar @values != scalar @format) { - &::WARN("dbSetRow: scalar values != scalar ${table} format."); + &WARN("dbSetRow: scalar values != scalar ${table} format."); } for (0 .. $#format) { + # @array? this is not defined anywhere. please fix, timriker!!! if (defined $array[$_] and $array[$_] ne "") { - &::DEBUG("dbSetRow: array[$_] != NULL($array[$_])."); + &DEBUG("dbSetRow: array[$_] != NULL($array[$_])."); } $array[$_] = $values[$_]; } @@ -258,10 +257,10 @@ sub dbSetRow { # Usage: &dbDel($table, $primkey, $primval, [$key]); sub dbDel { my ($table, $primkey, $primval, $key) = @_; - &::DEBUG("dbDel($table, $primkey, $primval);"); + &DEBUG("dbDel($table, $primkey, $primval);"); if (!defined ${$table}{lc $primval}) { - &::DEBUG("dbDel: lc $primval does not exist in $table."); + &DEBUG("dbDel: lc $primval does not exist in $table."); } else { delete ${$table}{lc $primval}; } @@ -274,7 +273,7 @@ sub dbDel { # Note: dbReplace does optional dbQuote. sub dbReplace { my ($table, $key, %hash) = @_; - &::DEBUG("dbReplace($table, $key, %hash);"); + &DEBUG("dbReplace($table, $key, %hash);"); &dbDel($table, $key, $hash{$key}, %hash); &dbInsert($table, $hash{$key}, %hash); @@ -285,14 +284,14 @@ sub dbReplace { # Usage: &dbSet($table, $primhash_ref, $hash_ref); sub dbSet { my ($table, $phref, $href) = @_; - &::DEBUG("dbSet(@_)"); + &DEBUG("dbSet(@_)"); my ($key) = keys %{$phref}; my $where = $key . "=" . $phref->{$key}; my %hash = &dbGetColNiceHash($table, "*", $where); $hash{$key}=$phref->{$key}; foreach (keys %{$href}) { - &::DEBUG("dbSet: setting $_=${$href}{$_}"); + &DEBUG("dbSet: setting $_=${$href}{$_}"); $hash{$_} = ${$href}{$_}; } &dbReplace($table, $key, %hash); @@ -300,11 +299,11 @@ sub dbSet { } sub dbRaw { - &::FIXME("STUB: &dbRaw(@_);"); + &FIXME("STUB: &dbRaw(@_);"); } sub dbRawReturn { - &::FIXME("STUB: &dbRawReturn(@_);"); + &FIXME("STUB: &dbRawReturn(@_);"); } @@ -318,11 +317,11 @@ sub countKeys { } sub getKeys { - return keys %{$_[0]}; + &FIXME("STUB: &getKeys(@_); -- REDUNDANT"); } sub randKey { - &::DEBUG("STUB: &randKey(@_);"); + &DEBUG("STUB: &randKey(@_);"); my ($table, $select) = @_; my @format = &dbGetColInfo($table); if (!scalar @format) { @@ -338,16 +337,16 @@ sub randKey { # Usage: &deleteTable($table); sub deleteTable { my ($table) = @_; - &::FIXME("STUB: deleteTable($table)"); + &FIXME("STUB: deleteTable($table)"); } ##### $select is misleading??? # Usage: &searchTable($table, $returnkey, $primkey, $str); sub searchTable { my ($table, $primkey, $key, $str) = @_; - &::FIXME("STUB: searchTable($table, $primkey, $key, $str)"); + &FIXME("STUB: searchTable($table, $primkey, $key, $str)"); return; - &::DEBUG("searchTable($table, $primkey, $key, $str)"); + &DEBUG("searchTable($table, $primkey, $key, $str)"); if (!scalar &dbGetColInfo($table)) { return; @@ -360,7 +359,7 @@ sub searchTable { push(@results, $_); } - &::DEBUG("sT: ".scalar(@results) ); + &DEBUG("sT: ".scalar(@results) ); @results; } @@ -385,7 +384,7 @@ sub getFactInfo { # specific. if (!grep /^$type$/, @format) { - &::ERROR("gFI: type '$type' not valid for factoids."); + &ERROR("gFI: type '$type' not valid for factoids."); return; } @@ -395,7 +394,7 @@ sub getFactInfo { return $array[$_]; } - &::ERROR("gFI: should never happen."); + &ERROR("gFI: should never happen."); } ##### @@ -404,7 +403,7 @@ sub getFactoid { my ($faqtoid) = @_; if (!defined $faqtoid or $faqtoid =~ /^\s*$/) { - &::WARN("getF: faqtoid == NULL."); + &WARN("getF: faqtoid == NULL."); return; } @@ -414,9 +413,9 @@ sub getFactoid { my $retval = (split $;, $factoids{$faqtoid})[1]; if (defined $retval) { - &::DEBUG("getF: returning '$retval' for '$faqtoid'."); + &DEBUG("getF: returning '$retval' for '$faqtoid'."); } else { - &::DEBUG("getF: returning NULL for '$faqtoid'."); + &DEBUG("getF: returning NULL for '$faqtoid'."); } return $retval; } else { @@ -430,15 +429,15 @@ sub delFactoid { my ($faqtoid) = @_; if (!defined $faqtoid or $faqtoid =~ /^\s*$/) { - &::WARN("delF: faqtoid == NULL."); + &WARN("delF: faqtoid == NULL."); return; } if (defined $factoids{$faqtoid}) { # dbm hash exception. delete $factoids{$faqtoid}; - &::status("DELETED $faqtoid"); + &status("DELETED $faqtoid"); } else { - &::WARN("delF: nothing to deleted? ($faqtoid)"); + &WARN("delF: nothing to deleted? ($faqtoid)"); return; } } -- 2.39.5