package main;
+eval {
+ # This wrapper's sole purpose in life is to keep the dbh connection open.
+ package Bloot::DBI;
+
+ # These are DBI methods which do not require an active DB
+ # connection. [Eg, don't check to see if the database is working
+ # by pinging it for these methods.]
+ my %no_ping;
+ @no_ping{qw(ping err err_str quote disconnect clone)} = (1) x 6;
+ sub new {
+ my $class = shift;
+ my $dbh = shift;
+ return undef unless $dbh;
+ $class = ref($class) if ref($class);
+ my $self = {dbh=>$dbh};
+ bless $self, $class;
+ return $self;
+ }
+
+ our $AUTOLOAD;
+ sub AUTOLOAD {
+ my $method = $AUTOLOAD;
+ my $self = shift;
+ die "Undefined subroutine $method called" unless defined $self;
+ ($method) = $method =~ /([^\:]+)$/;
+ unshift @_, $self->{dbh};
+ return undef if not defined $self->{dbh};
+ goto &{$self->{dbh}->can($method)} if exists $no_ping{$method} and $no_ping{$method};
+ my $ping_count = 0;
+ while (++$ping_count < 10){
+ last if $self->{dbh}->ping;
+ $self->{dbh}->disconnect;
+ $self->{dbh} = $self->{dbh}->clone;
+ }
+ if ($ping_count >=10 and not $self->{dbh}->ping){
+ &ERROR("Tried real hard but was unable to reconnect");
+ return undef;
+ }
+ $_[0] = $self->{dbh};
+ my $coderef = $self->{dbh}->can($method);
+ goto &$coderef if defined $coderef;
+ # Dumb DBI doesn't have a can method for some
+ # functions. Like func.
+ shift;
+ return eval "\$self->{dbh}->$method(\@_)" or die $@;
+ }
+ 1;
+};
+
#####
# &sqlOpenDB($dbname, $dbtype, $sqluser, $sqlpass, $nofail);
sub sqlOpenDB {
my ($db, $type, $user, $pass, $no_fail) = @_;
# this is a mess. someone fix it, please.
- if ($type =~ /^SQLite$/i) {
+ if ($type =~ /^SQLite(2)?$/i) {
$db = "dbname=$db.sqlite";
} elsif ($type =~ /^pg/i) {
$db = "dbname=$db";
$hoststr = " to $param{'SQLHost'}";
}
# SQLite ignores $user and $pass
- $dbh = DBI->connect($dsn, $user, $pass);
+ $dbh = Bloot::DBI->new(DBI->connect($dsn, $user, $pass));
if ($dbh && !$dbh->err) {
&status("Opened $type connection$hoststr");
} else {
- &ERROR("cannot connect$hoststr.");
- &ERROR("since $type is not available, shutting down bot!");
+ &ERROR("Cannot connect$hoststr.");
+ &ERROR("Since $type is not available, shutting down bot!");
&ERROR( $dbh->errstr ) if ($dbh);
&closePID();
&closeSHM($shm);
return;
}
- $query .= " WHERE ".&hashref2where($where_href) if ($where_href);
- $query .= "$other" if $other;
+ if ($where_href) {
+ my $where = &hashref2where($where_href);
+ $query .= " WHERE $where" if ($where);
+ }
+ $query .= " $other" if ($other);
if (!($sth = $dbh->prepare($query))) {
&ERROR("sqlSelectMany: prepare: $DBI::errstr");
}
&SQLDebug($query);
- if (!$sth->execute) {
- &ERROR("sqlSelectMany: execute: '$query'");
- $sth->finish;
- return;
- }
+
+ return if (!$sth->execute);
return $sth;
}
# Todo: Always return array?
sub sqlSelect {
my $sth = &sqlSelectMany(@_);
+ if (!defined $sth) {
+ &WARN("sqlSelect failed.");
+ return;
+ }
my @retval = $sth->fetchrow_array;
-
$sth->finish;
if (scalar @retval > 1) {
}
#####
-# Usage: &sqlSelectColHash($table, $select, [$where_href], [$type]);
+# Usage: &sqlSelectColArray($table, $select, [$where_href], [$other]);
+# Return: array.
+sub sqlSelectColArray {
+ my $sth = &sqlSelectMany(@_);
+ my @retval;
+
+ if (!defined $sth) {
+ &WARN("sqlSelect failed.");
+ return;
+ }
+
+ while (my @row = $sth->fetchrow_array) {
+ push(@retval, $row[0]);
+ }
+ $sth->finish;
+
+ return @retval;
+}
+
+#####
+# Usage: &sqlSelectColHash($table, $select, [$where_href], [$other], [$type]);
# Return: type = 1: $retval{ col2 }{ col1 } = 1;
# Return: no type: $retval{ col1 } = col2;
# Note: does not support $other, yet.
sub sqlSelectColHash {
- my ($table, $select, $where_href, $type) = @_;
- my $sth = &sqlSelectMany($table, $select, $where_href);
+ my ($table, $select, $where_href, $other, $type) = @_;
+ my $sth = &sqlSelectMany($table, $select, $where_href, $other);
+ if (!defined $sth) {
+ &WARN("sqlSelectColhash failed.");
+ return;
+ }
my %retval;
if (defined $type and $type == 2) {
- &DEBUG("dbgetcol: type 2!");
+ &DEBUG("sqlSelectColHash: type 2!");
while (my @row = $sth->fetchrow_array) {
$retval{$row[0]} = join(':', $row[1..$#row]);
}
- &DEBUG("dbgetcol: count => ".scalar(keys %retval) );
+ &DEBUG("sqlSelectColHash: count => ".scalar(keys %retval) );
} elsif (defined $type and $type == 1) {
while (my @row = $sth->fetchrow_array) {
# Note: useful for returning only one/first row of data.
sub sqlSelectRowHash {
my $sth = &sqlSelectMany(@_);
+ if (!defined $sth) {
+ &WARN("sqlSelectRowHash failed.");
+ return;
+ }
my $retval = $sth->fetchrow_hashref();
$sth->finish;
#
#####
-# Usage: &sqlSet($table, $data_href, $where_href);
+# Usage: &sqlSet($table, $where_href, $data_href);
# Return: 1 for success, undef for failure.
sub sqlSet {
- my ($table, $data_href, $where_href) = @_;
+ my ($table, $where_href, $data_href) = @_;
if (!defined $table or $table =~ /^\s*$/) {
&WARN("sqlSet: table == NULL.");
return;
}
- my $where = &hashref2where($where_href) if ($where_href);
- my $update = &hashref2update($data_href) if ($data_href);
- my (@k,@v) = &hashref2array($data_href);
-
- if (!@k or !@v) {
- &WARN("sqlSet: keys or vals is NULL.");
- return;
- }
+ # any column can be NULL... so just get them all.
+ my $k = join(',', keys %{ $where_href } );
+ my $result = &sqlSelect($table, $k, $where_href);
+# &DEBUG("result is not defined :(") if (!defined $result);
- my $result = &sqlGet($table, join(',', @k), $where);
+ # this was hardwired to use sqlUpdate. sqlite does not do inserts on sqlUpdate.
if (defined $result) {
&sqlUpdate($table, $data_href, $where_href);
} else {
+ # hack.
+ my %hash = %{ $where_href };
+ # add data_href values...
+ foreach (keys %{ $data_href }) {
+ $hash{ $_ } = ${ $data_href }{$_};
+ }
+
+ $data_href = \%hash;
&sqlInsert($table, $data_href);
}
if (!defined $data_href or ref($data_href) ne "HASH") {
&WARN("sqlSet: data_href == NULL.");
- return;
+ return 0;
}
my $where = &hashref2where($where_href) if ($where_href);
return;
}
- my (@k,@v) = &hashref2array($data_href);
+ my ($k_aref, $v_aref) = &hashref2array($data_href);
+ my @k = @{ $k_aref };
+ my @v = @{ $v_aref };
+
if (!@k or !@v) {
&WARN("sqlInsert: keys or vals is NULL.");
return;
&sqlRaw("Insert($table)", sprintf(
"INSERT %s INTO %s (%s) VALUES (%s)",
- $other, $table, join(',',@k), join(',',@v)
+ ($other || ""), $table, join(',',@k), join(',',@v)
) );
return 1;
return;
}
- my (@k,@v) = &hashref2array($data_href);
+ my ($k_aref, $v_aref) = &hashref2array($data_href);
+ my @k = @{ $k_aref };
+ my @v = @{ $v_aref };
+
if (!@k or !@v) {
&WARN("sqlReplace: keys or vals is NULL.");
return;
return 0;
}
-
while (my @row = $sth->fetchrow_array) {
push(@retval, $row[0]);
}
sub hashref2where {
my ($href) = @_;
+ if (!defined $href) {
+ &WARN("hashref2where: href == NULL.");
+ return;
+ }
+
if (ref($href) ne "HASH") {
- &WARN("hashref2where: href is not HASH ref.");
+ &WARN("hashref2where: href is not HASH ref (href => $href)");
return;
}
$hash{$k} = $v;
}
- return join(', ', map { $_ => $hash{$_} } sort keys %hash);
+ return join(', ', map { $_."=".$hash{$_} } sort keys %hash);
}
sub hashref2array {
sub countKeys {
my ($table, $col) = @_;
$col ||= "*";
- &DEBUG("&countKeys($table, $col);");
return (&sqlRawReturn("SELECT count($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 $rand,1";
- if ($param{DBType} =~ /^pg/i) {
- $query =~ s/$rand,1/1,$rand/;
+ my $rand = int(rand(&countKeys($table)));
+ my $query = "SELECT $select FROM $table LIMIT 1 OFFSET $rand";
+ if ($param{DBType} =~ /^mysql$/i) {
+ # WARN: only newer MySQL supports "LIMIT limit OFFSET offset"
+ $query = "SELECT $select FROM $table LIMIT $rand,1";
}
-
my $sth = $dbh->prepare($query);
&SQLDebug($query);
&WARN("randKey($query)") unless $sth->execute;
#####
# Usage: &searchTable($table, $select, $key, $str);
-# Note: searchTable does dbQuote.
+# Note: searchTable does sqlQuote.
sub searchTable {
my($table, $select, $key, $str) = @_;
my $origStr = $str;
# allow two types of wildcards.
if ($str =~ /^\^(.*)\$$/) {
- &DEBUG("searchTable: should use dbGet(), heh.");
+ &FIXME("searchTable: can't do \"$str\"");
$str = $1;
} else {
$str .= "%" if ($str =~ s/^\^//);
$str =~ s/\*/%/g;
# end of string fix.
- my $query = "SELECT $select FROM $table WHERE $key LIKE ".
+ my $query = "SELECT $select FROM $table WHERE $key LIKE ".
&sqlQuote($str);
my $sth = $dbh->prepare($query);
return @results;
}
-sub dbCreateTable {
+sub sqlCreateTable {
my($table) = @_;
my(@path) = ($bot_data_dir, ".","..","../..");
my $found = 0;
foreach (@path) {
my $file = "$_/setup/$table.sql";
- &DEBUG("dbCT: table => '$table', file => '$file'");
next unless ( -f $file );
- &DEBUG("dbCT: found!!!");
-
open(IN, $file);
while (<IN>) {
chop;
if (!$found) {
return 0;
} else {
- &sqlRaw("dbcreateTable($table)", $data);
+ &sqlRaw("sqlCreateTable($table)", $data);
return 1;
}
}
}
# retrieve a list of db's from the server.
- foreach ($dbh->func('_ListTables')) {
- $db{$_} = 1;
- }
+ my @tables = map {s/^\`//; s/\`$//; $_;} $dbh->func('_ListTables');
+ if ($#tables == -1){
+ @tables = $dbh->tables;
+ }
+ &status("Tables: ".join(',',@tables));
+ @db{@tables} = (1) x @tables;
- } elsif ($param{DBType} =~ /^SQLite$/i) {
+ } elsif ($param{DBType} =~ /^SQLite(2)?$/i) {
# retrieve a list of db's from the server.
foreach ( &sqlRawReturn("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'}";
- &sqlRaw("create(db $param{'DBName'})", $query);
- }
+ # create database not needed for SQLite
}
- foreach ( qw(factoids freshmeat rootwarn seen stats botmail) ) {
- next if (exists $db{$_});
+ foreach ( qw(botmail connections factoids rootwarn seen stats onjoin) ) {
+ if (exists $db{$_}) {
+ $cache{has_table}{$_} = 1;
+ next;
+ }
+
&status("checkTables: creating new table $_...");
+ $cache{create_table}{$_} = 1;
+
&sqlCreateTable($_);
}
}
projects / infobot.git / blobdiff