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 # &sqlOpenDB($dbname, $dbtype, $sqluser, $sqlpass, $nofail);
20 my ($db, $type, $user, $pass, $no_fail) = @_;
21 # this is a mess. someone fix it, please.
22 if ($type =~ /^SQLite(2)?$/i) {
23 $db = "dbname=$db.sqlite";
24 } elsif ($type =~ /^pg/i) {
29 my $dsn = "DBI:$type:$db";
31 # SQLHost should be unset for SQLite
32 if (exists $param{'SQLHost'} and $param{'SQLHost'}) {
33 # PostgreSQL requires ";" and keyword "host". See perldoc Pg -- troubled
35 $dsn .= ";host=$param{SQLHost}";
37 $dsn .= ":$param{SQLHost}";
39 $hoststr = " to $param{'SQLHost'}";
41 # SQLite ignores $user and $pass
42 $dbh = DBI->connect($dsn, $user, $pass);
44 if ($dbh && !$dbh->err) {
45 &status("Opened $type connection$hoststr");
47 &ERROR("Cannot connect$hoststr.");
48 &ERROR("Since $type is not available, shutting down bot!");
49 &ERROR( $dbh->errstr ) if ($dbh);
54 return 0 if ($no_fail);
61 return 0 unless ($dbh);
63 my $x = $param{SQLHost};
64 my $hoststr = ($x) ? " to $x" : "";
66 &status("Closed DBI connection$hoststr.");
73 # Usage: &sqlQuote($str);
75 return $dbh->quote($_[0]);
79 # Usage: &sqlSelectMany($table, $select, [$where_href], [$other]);
80 # Return: $sth (Statement handle object)
82 my($table, $select, $where_href, $other) = @_;
83 my $query = "SELECT $select FROM $table";
86 if (!defined $select or $select =~ /^\s*$/) {
87 &WARN("sqlSelectMany: select == NULL.");
91 if (!defined $table or $table =~ /^\s*$/) {
92 &WARN("sqlSelectMany: table == NULL.");
97 my $where = &hashref2where($where_href);
98 $query .= " WHERE $where" if ($where);
100 $query .= " $other" if ($other);
102 if (!($sth = $dbh->prepare($query))) {
103 &ERROR("sqlSelectMany: prepare: $DBI::errstr");
109 return if (!$sth->execute);
115 # Usage: &sqlSelect($table, $select, [$where_href, [$other]);
116 # Return: scalar if one element, array if list of elements.
117 # Note: Suitable for one column returns, that is, one column in $select.
118 # Todo: Always return array?
120 my $sth = &sqlSelectMany(@_);
122 &WARN("sqlSelect failed.");
125 my @retval = $sth->fetchrow_array;
128 if (scalar @retval > 1) {
130 } elsif (scalar @retval == 1) {
138 # Usage: &sqlSelectColArray($table, $select, [$where_href], [$other]);
140 sub sqlSelectColArray {
141 my $sth = &sqlSelectMany(@_);
145 &WARN("sqlSelect failed.");
149 while (my @row = $sth->fetchrow_array) {
150 push(@retval, $row[0]);
158 # Usage: &sqlSelectColHash($table, $select, [$where_href], [$other], [$type]);
159 # Return: type = 1: $retval{ col2 }{ col1 } = 1;
160 # Return: no type: $retval{ col1 } = col2;
161 # Note: does not support $other, yet.
162 sub sqlSelectColHash {
163 my ($table, $select, $where_href, $other, $type) = @_;
164 my $sth = &sqlSelectMany($table, $select, $where_href, $other);
166 &WARN("sqlSelectColhash failed.");
171 if (defined $type and $type == 2) {
172 &DEBUG("sqlSelectColHash: type 2!");
173 while (my @row = $sth->fetchrow_array) {
174 $retval{$row[0]} = join(':', $row[1..$#row]);
176 &DEBUG("sqlSelectColHash: count => ".scalar(keys %retval) );
178 } elsif (defined $type and $type == 1) {
179 while (my @row = $sth->fetchrow_array) {
180 # reverse it to make it easier to count.
181 if (scalar @row == 2) {
182 $retval{$row[1]}{$row[0]} = 1;
183 } elsif (scalar @row == 3) {
184 $retval{$row[1]}{$row[0]} = 1;
186 # what to do if there's only one or more than 3?
190 while (my @row = $sth->fetchrow_array) {
191 $retval{$row[0]} = $row[1];
201 # Usage: &sqlSelectRowHash($table, $select, [$where_href]);
202 # Return: $hash{ col } = value;
203 # Note: useful for returning only one/first row of data.
204 sub sqlSelectRowHash {
205 my $sth = &sqlSelectMany(@_);
207 &WARN("sqlSelectRowHash failed.");
210 my $retval = $sth->fetchrow_hashref();
221 # End of SELECT functions.
225 # Usage: &sqlSet($table, $where_href, $data_href);
226 # Return: 1 for success, undef for failure.
228 my ($table, $where_href, $data_href) = @_;
230 if (!defined $table or $table =~ /^\s*$/) {
231 &WARN("sqlSet: table == NULL.");
235 if (!defined $data_href or ref($data_href) ne "HASH") {
236 &WARN("sqlSet: data_href == NULL.");
240 # any column can be NULL... so just get them all.
241 my $k = join(',', keys %{ $where_href } );
242 my $result = &sqlSelect($table, $k, $where_href);
243 # &DEBUG("result is not defined :(") if (!defined $result);
245 # this was hardwired to use sqlUpdate. sqlite does not do inserts on sqlUpdate.
246 if (defined $result) {
247 &sqlUpdate($table, $data_href, $where_href);
250 my %hash = %{ $where_href };
251 # add data_href values...
252 foreach (keys %{ $data_href }) {
253 $hash{ $_ } = ${ $data_href }{$_};
257 &sqlInsert($table, $data_href);
264 # Usage: &sqlUpdate($table, $data_href, $where_href);
266 my ($table, $data_href, $where_href) = @_;
268 if (!defined $data_href or ref($data_href) ne "HASH") {
269 &WARN("sqlSet: data_href == NULL.");
273 my $where = &hashref2where($where_href) if ($where_href);
274 my $update = &hashref2update($data_href) if ($data_href);
276 &sqlRaw("Update", "UPDATE $table SET $update WHERE $where");
282 # Usage: &sqlInsert($table, $data_href, $other);
284 my ($table, $data_href, $other) = @_;
285 # note: if $other == 1, add "DELAYED" to function instead.
286 # note: ^^^ doesnt actually do anything lol. Need code to s/1/DELAYED/ below -- troubled
288 if (!defined $data_href or ref($data_href) ne "HASH") {
289 &WARN("sqlInsert: data_href == NULL.");
293 my ($k_aref, $v_aref) = &hashref2array($data_href);
294 my @k = @{ $k_aref };
295 my @v = @{ $v_aref };
298 &WARN("sqlInsert: keys or vals is NULL.");
302 return &sqlRaw("Insert($table)", sprintf(
303 "INSERT %s INTO %s (%s) VALUES (%s)",
304 ($other || ""), $table, join(',',@k), join(',',@v)
309 # Usage: &sqlReplace($table, $data_href, [$pkey]);
311 my ($table, $data_href, $pkey) = @_;
313 if (!defined $data_href or ref($data_href) ne "HASH") {
314 &WARN("sqlReplace: data_href == NULL.");
318 my ($k_aref, $v_aref) = &hashref2array($data_href);
319 my @k = @{ $k_aref };
320 my @v = @{ $v_aref };
323 &WARN("sqlReplace: keys or vals is NULL.");
328 if ($param{'DBType'} =~ /^pgsql$/i) {
329 # OK, heres the scoop. There is currently no REPLACE INTO in Pgsql.
330 # However, the bot already seems to search for factoids before insert
331 # anyways. Perhaps we could change this to a generic INSERT INTO so
332 # we can skip the seperate sql? -- troubled to: TimRiker
333 # PGSql syntax: UPDATE table SET key = 'value', key2 = 'value2' WHERE key = 'value'
335 # &sqlRaw("Replace($table)", sprintf(
336 # "INSERT INTO %s (%s) VALUES (%s)",
337 # $table, join(',',@k), join(',',@v)
339 &WARN("DEBUG: ($pkey = ) " . sprintf(
340 "REPLACE INTO %s (%s) VALUES (%s)",
341 $table, join(',',@k), join(',',@v)
345 &sqlRaw("Replace($table)", sprintf(
346 "REPLACE INTO %s (%s) VALUES (%s)",
347 $table, join(',',@k), join(',',@v)
355 # Usage: &sqlDelete($table, $where_href);
357 my ($table, $where_href) = @_;
359 if (!defined $where_href or ref($where_href) ne "HASH") {
360 &WARN("sqlDelete: where_href == NULL.");
364 my $where = &hashref2where($where_href);
366 &sqlRaw("Delete", "DELETE FROM $table WHERE $where");
372 # Usage: &sqlRaw($prefix, $query);
373 # Return: 1 for success, 0 for failure.
375 my ($prefix, $query) = @_;
378 if (!defined $query or $query =~ /^\s*$/) {
379 &WARN("sqlRaw: query == NULL.");
383 if (!($sth = $dbh->prepare($query))) {
384 &ERROR("Raw($prefix): !prepare => '$query'");
389 if (!$sth->execute) {
390 &ERROR("Raw($prefix): !execute => '$query'");
401 # Usage: &sqlRawReturn($query);
408 if (!defined $query or $query =~ /^\s*$/) {
409 &WARN("sqlRawReturn: query == NULL.");
413 if (!($sth = $dbh->prepare($query))) {
414 &ERROR("RawReturn: !prepare => '$query'");
419 if (!$sth->execute) {
420 &ERROR("RawReturn: !execute => '$query'");
425 while (my @row = $sth->fetchrow_array) {
426 push(@retval, $row[0]);
434 ####################################################################
435 ##### Misc DBI stuff...
441 if (!defined $href) {
442 &WARN("hashref2where: href == NULL.");
446 if (ref($href) ne "HASH") {
447 &WARN("hashref2where: href is not HASH ref (href => $href)");
451 my %hash = %{ $href };
452 foreach (keys %hash) {
455 if (s/^-//) { # as is.
457 delete $hash{'-'.$_};
459 $hash{$_} = &sqlQuote($v);
463 return join(' AND ', map { $_."=".$hash{$_} } keys %hash );
469 if (ref($href) ne "HASH") {
470 &WARN("hashref2update: href is not HASH ref.");
475 foreach (keys %{ $href }) {
477 my $v = ${ $href }{$_};
479 # is there a better way to do this?
480 if ($k =~ s/^-//) { # as is.
489 return join(', ', map { $_."=".$hash{$_} } sort keys %hash);
495 if (ref($href) ne "HASH") {
496 &WARN("hashref2update: href is not HASH ref.");
501 foreach (keys %{ $href }) {
503 my $v = ${ $href }{$_};
505 # is there a better way to do this?
506 if ($k =~ s/^-//) { # as is.
520 # Usage: &countKeys($table, [$col]);
522 my ($table, $col) = @_;
525 return (&sqlRawReturn("SELECT count($col) FROM $table"))[0];
529 # Usage: &sumKey($table, $col);
531 my ($table, $col) = @_;
533 return (&sqlRawReturn("SELECT sum($col) FROM $table"))[0];
537 # Usage: &randKey($table, $select);
539 my ($table, $select) = @_;
540 my $rand = int(rand(&countKeys($table)));
541 my $query = "SELECT $select FROM $table LIMIT 1 OFFSET $rand";
542 if ($param{DBType} =~ /^mysql$/i) {
543 # WARN: only newer MySQL supports "LIMIT limit OFFSET offset"
544 $query = "SELECT $select FROM $table LIMIT $rand,1";
546 my $sth = $dbh->prepare($query);
548 &WARN("randKey($query)") unless $sth->execute;
549 my @retval = $sth->fetchrow_array;
556 # Usage: &deleteTable($table);
558 &sqlRaw("deleteTable($_[0])", "DELETE FROM $_[0]");
562 # Usage: &searchTable($table, $select, $key, $str);
563 # Note: searchTable does sqlQuote.
565 my($table, $select, $key, $str) = @_;
569 # allow two types of wildcards.
570 if ($str =~ /^\^(.*)\$$/) {
571 &FIXME("searchTable: can't do \"$str\"");
574 $str .= "%" if ($str =~ s/^\^//);
575 $str = "%".$str if ($str =~ s/\$$//);
576 $str = "%".$str."%" if ($str eq $origStr); # el-cheapo fix.
580 $str =~ s/\?/_/g; # '.' should be supported, too.
584 my $query = "SELECT $select FROM $table WHERE $key LIKE ".
586 my $sth = $dbh->prepare($query);
589 if (!$sth->execute) {
590 &WARN("Search($query)");
595 while (my @row = $sth->fetchrow_array) {
596 push(@results, $row[0]);
604 my($table, $dbtype) = @_;
605 my(@path) = ($bot_data_dir, ".","..","../..");
608 $dbtype = lc $dbtype;
611 my $file = "$_/setup/$dbtype/$table.sql";
612 next unless ( -f $file );
628 &sqlRaw("sqlCreateTable($table)", $data);
634 my $database_exists = 0;
637 if ($param{DBType} =~ /^mysql$/i) {
638 my $sql = "SHOW DATABASES";
639 foreach ( &sqlRawReturn($sql) ) {
640 $database_exists++ if ($_ eq $param{'DBName'});
643 unless ($database_exists) {
644 &status("Creating database $param{DBName}...");
645 my $query = "CREATE DATABASE $param{DBName}";
646 &sqlRaw("create(db $param{DBName})", $query);
649 # retrieve a list of db's from the server.
650 my @tables = map {s/^\`//; s/\`$//; $_;} $dbh->func('_ListTables');
652 @tables = $dbh->tables;
654 &status("Tables: ".join(',',@tables));
655 @db{@tables} = (1) x @tables;
657 } elsif ($param{DBType} =~ /^SQLite(2)?$/i) {
659 # retrieve a list of db's from the server.
660 foreach ( &sqlRawReturn("SELECT name FROM sqlite_master WHERE type='table'") ) {
664 # create database not needed for SQLite
666 } elsif ($param{DBType} =~ /^pgsql$/i) {
667 # $sql_showDB = SQL to select the DB list
668 # $sql_showTBL = SQL to select all tables for the current connection
670 my $sql_showDB = "SELECT datname FROM pg_database";
671 my $sql_showTBL = "SELECT tablename FROM pg_tables \
672 WHERE schemaname = 'public'";
674 foreach ( &sqlRawReturn($sql_showDB) ) {
675 $database_exists++ if ($_ eq $param{'DBName'});
678 unless ($database_exists) {
679 &status("Creating PostgreSQL database $param{'DBName'}");
680 &status("(actually, not really, please read the INSTALL file)");
683 # retrieve a list of db's from the server. This code is from mysql above, please check -- troubled
684 my @tables = map {s/^\`//; s/\`$//; $_;} &sqlRawReturn($sql_showTBL);
686 @tables = $dbh->tables;
688 &status("Tables: ".join(',',@tables));
689 @db{@tables} = (1) x @tables;
692 foreach ( qw(botmail connections factoids rootwarn seen stats onjoin) ) {
693 if (exists $db{$_}) {
694 $cache{has_table}{$_} = 1;
698 &status("checkTables: creating new table $_...");
700 $cache{create_table}{$_} = 1;
702 &sqlCreateTable($_, $param{DBType});