2 # dbi.pl: DBI (mysql/pgsql/sqlite) database frontend.
4 # Version: v0.9a (20021124)
6 # Notes: based on db_mysql.pl
7 # overhauled to be 31337.
13 use vars qw($dbh $shm $bot_data_dir);
18 # This wrapper's sole purpose in life is to keep the dbh connection open.
21 # These are DBI methods which do not require an active DB
22 # connection. [Eg, don't check to see if the database is working
23 # by pinging it for these methods.]
25 @no_ping{qw(ping err err_str quote disconnect clone)} = (1) x 6;
29 return undef unless $dbh;
30 $class = ref($class) if ref($class);
31 my $self = {dbh=>$dbh};
38 my $method = $AUTOLOAD;
40 die "Undefined subroutine $method called" unless defined $self;
41 ($method) = $method =~ /([^\:]+)$/;
42 unshift @_, $self->{dbh};
43 return undef if not defined $self->{dbh};
44 goto &{$self->{dbh}->can($method)} if exists $no_ping{$method} and $no_ping{$method};
46 while (++$ping_count < 10){
47 last if $self->{dbh}->ping;
48 $self->{dbh}->disconnect;
49 $self->{dbh} = $self->{dbh}->clone;
51 if ($ping_count >=10 and not $self->{dbh}->ping){
52 &ERROR("Tried real hard but was unable to reconnect");
56 my $coderef = $self->{dbh}->can($method);
57 goto &$coderef if defined $coderef;
58 # Dumb DBI doesn't have a can method for some
59 # functions. Like func.
61 return eval "\$self->{dbh}->$method(\@_)" or die $@;
67 # &sqlOpenDB($dbname, $dbtype, $sqluser, $sqlpass, $nofail);
69 my ($db, $type, $user, $pass, $no_fail) = @_;
70 # this is a mess. someone fix it, please.
71 if ($type =~ /^SQLite(2)?$/i) {
72 $db = "dbname=$db.sqlite";
73 } elsif ($type =~ /^pg/i) {
78 my $dsn = "DBI:$type:$db";
80 # SQLHost should be unset for SQLite
81 if (exists $param{'SQLHost'} and $param{'SQLHost'}) {
82 # PostgreSQL requires ";" and keyword 'host'. See perldoc Pg -- troubled
84 $dsn .= ";host=$param{SQLHost}";
86 $dsn .= ":$param{SQLHost}";
88 $hoststr = " to $param{'SQLHost'}";
90 # SQLite ignores $user and $pass
91 $dbh = Bloot::DBI->new(DBI->connect($dsn, $user, $pass));
93 if ($dbh && !$dbh->err) {
94 &status("Opened $type connection$hoststr");
96 &ERROR("Cannot connect$hoststr.");
97 &ERROR("Since $type is not available, shutting down bot!");
98 &ERROR( $dbh->errstr ) if ($dbh);
103 return 0 if ($no_fail);
110 return 0 unless ($dbh);
112 my $x = $param{SQLHost};
113 my $hoststr = ($x) ? " to $x" : '';
115 &status("Closed DBI connection$hoststr.");
122 # Usage: &sqlQuote($str);
124 return $dbh->quote($_[0]);
128 # Usage: &sqlSelectMany($table, $select, [$where_href], [$other]);
129 # Return: $sth (Statement handle object)
131 my($table, $select, $where_href, $other) = @_;
132 my $query = "SELECT $select FROM $table";
135 if (!defined $select or $select =~ /^\s*$/) {
136 &WARN("sqlSelectMany: select == NULL.");
140 if (!defined $table or $table =~ /^\s*$/) {
141 &WARN("sqlSelectMany: table == NULL.");
146 my $where = &hashref2where($where_href);
147 $query .= " WHERE $where" if ($where);
149 $query .= " $other" if ($other);
151 if (!($sth = $dbh->prepare($query))) {
152 &ERROR("sqlSelectMany: prepare: $DBI::errstr");
158 return if (!$sth->execute);
164 # Usage: &sqlSelect($table, $select, [$where_href, [$other]);
165 # Return: scalar if one element, array if list of elements.
166 # Note: Suitable for one column returns, that is, one column in $select.
167 # Todo: Always return array?
169 my $sth = &sqlSelectMany(@_);
171 &WARN("sqlSelect failed.");
174 my @retval = $sth->fetchrow_array;
177 if (scalar @retval > 1) {
179 } elsif (scalar @retval == 1) {
187 # Usage: &sqlSelectColArray($table, $select, [$where_href], [$other]);
189 sub sqlSelectColArray {
190 my $sth = &sqlSelectMany(@_);
194 &WARN("sqlSelect failed.");
198 while (my @row = $sth->fetchrow_array) {
199 push(@retval, $row[0]);
207 # Usage: &sqlSelectColHash($table, $select, [$where_href], [$other], [$type]);
208 # Return: type = 1: $retval{ col2 }{ col1 } = 1;
209 # Return: no type: $retval{ col1 } = col2;
210 # Note: does not support $other, yet.
211 sub sqlSelectColHash {
212 my ($table, $select, $where_href, $other, $type) = @_;
213 my $sth = &sqlSelectMany($table, $select, $where_href, $other);
215 &WARN("sqlSelectColhash failed.");
220 if (defined $type and $type == 2) {
221 &DEBUG("sqlSelectColHash: type 2!");
222 while (my @row = $sth->fetchrow_array) {
223 $retval{$row[0]} = join(':', $row[1..$#row]);
225 &DEBUG("sqlSelectColHash: count => ".scalar(keys %retval) );
227 } elsif (defined $type and $type == 1) {
228 while (my @row = $sth->fetchrow_array) {
229 # reverse it to make it easier to count.
230 if (scalar @row == 2) {
231 $retval{$row[1]}{$row[0]} = 1;
232 } elsif (scalar @row == 3) {
233 $retval{$row[1]}{$row[0]} = 1;
235 # what to do if there's only one or more than 3?
239 while (my @row = $sth->fetchrow_array) {
240 $retval{$row[0]} = $row[1];
250 # Usage: &sqlSelectRowHash($table, $select, [$where_href]);
251 # Return: $hash{ col } = value;
252 # Note: useful for returning only one/first row of data.
253 sub sqlSelectRowHash {
254 my $sth = &sqlSelectMany(@_);
256 &WARN("sqlSelectRowHash failed.");
259 my $retval = $sth->fetchrow_hashref();
270 # End of SELECT functions.
274 # Usage: &sqlSet($table, $where_href, $data_href);
275 # Return: 1 for success, undef for failure.
277 my ($table, $where_href, $data_href) = @_;
279 if (!defined $table or $table =~ /^\s*$/) {
280 &WARN("sqlSet: table == NULL.");
284 if (!defined $data_href or ref($data_href) ne 'HASH') {
285 &WARN("sqlSet: data_href == NULL.");
289 # any column can be NULL... so just get them all.
290 my $k = join(',', keys %{ $where_href } );
291 my $result = &sqlSelect($table, $k, $where_href);
292 # &DEBUG("result is not defined :(") if (!defined $result);
294 # this was hardwired to use sqlUpdate. sqlite does not do inserts on sqlUpdate.
295 if (defined $result) {
296 &sqlUpdate($table, $data_href, $where_href);
299 my %hash = %{ $where_href };
300 # add data_href values...
301 foreach (keys %{ $data_href }) {
302 $hash{ $_ } = ${ $data_href }{$_};
306 &sqlInsert($table, $data_href);
313 # Usage: &sqlUpdate($table, $data_href, $where_href);
315 my ($table, $data_href, $where_href) = @_;
317 if (!defined $data_href or ref($data_href) ne 'HASH') {
318 &WARN("sqlSet: data_href == NULL.");
322 my $where = &hashref2where($where_href) if ($where_href);
323 my $update = &hashref2update($data_href) if ($data_href);
325 &sqlRaw('Update', "UPDATE $table SET $update WHERE $where");
331 # Usage: &sqlInsert($table, $data_href, $other);
333 my ($table, $data_href, $other) = @_;
334 # note: if $other == 1, add 'DELAYED' to function instead.
335 # note: ^^^ doesnt actually do anything lol. Need code to s/1/DELAYED/ below -- troubled
337 if (!defined $data_href or ref($data_href) ne 'HASH') {
338 &WARN("sqlInsert: data_href == NULL.");
342 my ($k_aref, $v_aref) = &hashref2array($data_href);
343 my @k = @{ $k_aref };
344 my @v = @{ $v_aref };
347 &WARN("sqlInsert: keys or vals is NULL.");
351 &sqlRaw("Insert($table)", sprintf(
352 "INSERT %s INTO %s (%s) VALUES (%s)",
353 ($other || ''), $table, join(',',@k), join(',',@v)
360 # Usage: &sqlReplace($table, $data_href, [$pkey]);
362 my ($table, $data_href, $pkey) = @_;
364 if (!defined $data_href or ref($data_href) ne 'HASH') {
365 &WARN("sqlReplace: data_href == NULL.");
369 my ($k_aref, $v_aref) = &hashref2array($data_href);
370 my @k = @{ $k_aref };
371 my @v = @{ $v_aref };
374 &WARN("sqlReplace: keys or vals is NULL.");
379 if ($param{'DBType'} =~ /^pgsql$/i) {
380 # OK, heres the scoop. There is currently no REPLACE INTO in Pgsql.
381 # However, the bot already seems to search for factoids before insert
382 # anyways. Perhaps we could change this to a generic INSERT INTO so
383 # we can skip the seperate sql? -- troubled to: TimRiker
384 # PGSql syntax: UPDATE table SET key = 'value', key2 = 'value2' WHERE key = 'value'
386 # &sqlRaw("Replace($table)", sprintf(
387 # "INSERT INTO %s (%s) VALUES (%s)",
388 # $table, join(',',@k), join(',',@v)
390 &WARN("DEBUG: ($pkey = ) " . sprintf(
391 "REPLACE INTO %s (%s) VALUES (%s)",
392 $table, join(',',@k), join(',',@v)
396 &sqlRaw("Replace($table)", sprintf(
397 "REPLACE INTO %s (%s) VALUES (%s)",
398 $table, join(',',@k), join(',',@v)
406 # Usage: &sqlDelete($table, $where_href);
408 my ($table, $where_href) = @_;
410 if (!defined $where_href or ref($where_href) ne 'HASH') {
411 &WARN("sqlDelete: where_href == NULL.");
415 my $where = &hashref2where($where_href);
417 &sqlRaw('Delete', "DELETE FROM $table WHERE $where");
423 # Usage: &sqlRaw($prefix, $query);
424 # Return: 1 for success, 0 for failure.
426 my ($prefix, $query) = @_;
429 if (!defined $query or $query =~ /^\s*$/) {
430 &WARN("sqlRaw: query == NULL.");
434 if (!($sth = $dbh->prepare($query))) {
435 &ERROR("Raw($prefix): !prepare => '$query'");
440 if (!$sth->execute) {
441 &ERROR("Raw($prefix): !execute => '$query'");
452 # Usage: &sqlRawReturn($query);
459 if (!defined $query or $query =~ /^\s*$/) {
460 &WARN("sqlRawReturn: query == NULL.");
464 if (!($sth = $dbh->prepare($query))) {
465 &ERROR("RawReturn: !prepare => '$query'");
470 if (!$sth->execute) {
471 &ERROR("RawReturn: !execute => '$query'");
476 while (my @row = $sth->fetchrow_array) {
477 push(@retval, $row[0]);
485 ####################################################################
486 ##### Misc DBI stuff...
492 if (!defined $href) {
493 &WARN("hashref2where: href == NULL.");
497 if (ref($href) ne 'HASH') {
498 &WARN("hashref2where: href is not HASH ref (href => $href)");
502 my %hash = %{ $href };
503 foreach (keys %hash) {
506 if (s/^-//) { # as is.
508 delete $hash{'-'.$_};
510 $hash{$_} = &sqlQuote($v);
514 return join(' AND ', map { $_."=".$hash{$_} } keys %hash );
520 if (ref($href) ne 'HASH') {
521 &WARN("hashref2update: href is not HASH ref.");
526 foreach (keys %{ $href }) {
528 my $v = ${ $href }{$_};
530 # is there a better way to do this?
531 if ($k =~ s/^-//) { # as is.
540 return join(', ', map { $_."=".$hash{$_} } sort keys %hash);
546 if (ref($href) ne 'HASH') {
547 &WARN("hashref2update: href is not HASH ref.");
552 foreach (keys %{ $href }) {
554 my $v = ${ $href }{$_};
556 # is there a better way to do this?
557 if ($k =~ s/^-//) { # as is.
571 # Usage: &countKeys($table, [$col]);
573 my ($table, $col) = @_;
576 return (&sqlRawReturn("SELECT count($col) FROM $table"))[0];
580 # Usage: &sumKey($table, $col);
582 my ($table, $col) = @_;
584 return (&sqlRawReturn("SELECT sum($col) FROM $table"))[0];
588 # Usage: &randKey($table, $select);
590 my ($table, $select) = @_;
591 my $rand = int(rand(&countKeys($table)));
592 my $query = "SELECT $select FROM $table LIMIT 1 OFFSET $rand";
593 if ($param{DBType} =~ /^mysql$/i) {
594 # WARN: only newer MySQL supports "LIMIT limit OFFSET offset"
595 $query = "SELECT $select FROM $table LIMIT $rand,1";
597 my $sth = $dbh->prepare($query);
599 &WARN("randKey($query)") unless $sth->execute;
600 my @retval = $sth->fetchrow_array;
607 # Usage: &deleteTable($table);
609 &sqlRaw("deleteTable($_[0])", "DELETE FROM $_[0]");
613 # Usage: &searchTable($table, $select, $key, $str);
614 # Note: searchTable does sqlQuote.
616 my($table, $select, $key, $str) = @_;
620 # allow two types of wildcards.
621 if ($str =~ /^\^(.*)\$$/) {
622 &FIXME("searchTable: can't do \"$str\"");
625 $str .= "%" if ($str =~ s/^\^//);
626 $str = "%".$str if ($str =~ s/\$$//);
627 $str = "%".$str."%" if ($str eq $origStr); # el-cheapo fix.
631 $str =~ s/\?/_/g; # '.' should be supported, too.
635 my $query = "SELECT $select FROM $table WHERE $key LIKE ".
637 my $sth = $dbh->prepare($query);
640 if (!$sth->execute) {
641 &WARN("Search($query)");
646 while (my @row = $sth->fetchrow_array) {
647 push(@results, $row[0]);
655 my($table, $dbtype) = @_;
656 my(@path) = ($bot_data_dir, ".","..","../..");
659 $dbtype = lc $dbtype;
662 my $file = "$_/setup/$dbtype/$table.sql";
663 next unless ( -f $file );
679 &sqlRaw("sqlCreateTable($table)", $data);
685 my $database_exists = 0;
688 if ($param{DBType} =~ /^mysql$/i) {
689 my $sql = "SHOW DATABASES";
690 foreach ( &sqlRawReturn($sql) ) {
691 $database_exists++ if ($_ eq $param{'DBName'});
694 unless ($database_exists) {
695 &status("Creating database $param{DBName}...");
696 my $query = "CREATE DATABASE $param{DBName}";
697 &sqlRaw("create(db $param{DBName})", $query);
700 # retrieve a list of db's from the server.
701 my @tables = map {s/^\`//; s/\`$//; $_;} $dbh->func('_ListTables');
703 @tables = $dbh->tables;
705 &status("Tables: ".join(',',@tables));
706 @db{@tables} = (1) x @tables;
708 } elsif ($param{DBType} =~ /^SQLite(2)?$/i) {
710 # retrieve a list of db's from the server.
711 foreach ( &sqlRawReturn("SELECT name FROM sqlite_master WHERE type='table'") ) {
715 # create database not needed for SQLite
717 } elsif ($param{DBType} =~ /^pgsql$/i) {
718 # $sql_showDB = SQL to select the DB list
719 # $sql_showTBL = SQL to select all tables for the current connection
721 my $sql_showDB = "SELECT datname FROM pg_database";
722 my $sql_showTBL = "SELECT tablename FROM pg_tables \
723 WHERE schemaname = 'public'";
725 foreach ( &sqlRawReturn($sql_showDB) ) {
726 $database_exists++ if ($_ eq $param{'DBName'});
729 unless ($database_exists) {
730 &status("Creating PostgreSQL database $param{'DBName'}");
731 &status("(actually, not really, please read the INSTALL file)");
734 # retrieve a list of db's from the server. This code is from mysql above, please check -- troubled
735 my @tables = map {s/^\`//; s/\`$//; $_;} &sqlRawReturn($sql_showTBL);
737 @tables = $dbh->tables;
739 &status("Tables: ".join(',',@tables));
740 @db{@tables} = (1) x @tables;
743 foreach ( qw(botmail connections factoids rootwarn seen stats onjoin) ) {
744 if (exists $db{$_}) {
745 $cache{has_table}{$_} = 1;
749 &status("checkTables: creating new table $_...");
751 $cache{create_table}{$_} = 1;
753 &sqlCreateTable($_, $param{DBType});