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 $dsn .= ":$param{SQLHost}";
34 $hoststr = " to $param{'SQLHost'}";
36 # SQLite ignores $user and $pass
37 $dbh = DBI->connect($dsn, $user, $pass);
39 if ($dbh && !$dbh->err) {
40 &status("Opened $type connection$hoststr");
42 &ERROR("Cannot connect$hoststr.");
43 &ERROR("Since $type is not available, shutting down bot!");
44 &ERROR( $dbh->errstr ) if ($dbh);
49 return 0 if ($no_fail);
56 return 0 unless ($dbh);
58 my $x = $param{SQLHost};
59 my $hoststr = ($x) ? " to $x" : "";
61 &status("Closed DBI connection$hoststr.");
68 # Usage: &sqlQuote($str);
70 return $dbh->quote($_[0]);
74 # Usage: &sqlSelectMany($table, $select, [$where_href], [$other]);
75 # Return: $sth (Statement handle object)
77 my($table, $select, $where_href, $other) = @_;
78 my $query = "SELECT $select FROM $table";
81 if (!defined $select or $select =~ /^\s*$/) {
82 &WARN("sqlSelectMany: select == NULL.");
86 if (!defined $table or $table =~ /^\s*$/) {
87 &WARN("sqlSelectMany: table == NULL.");
92 my $where = &hashref2where($where_href);
93 $query .= " WHERE $where" if ($where);
95 $query .= " $other" if ($other);
97 if (!($sth = $dbh->prepare($query))) {
98 &ERROR("sqlSelectMany: prepare: $DBI::errstr");
104 return if (!$sth->execute);
110 # Usage: &sqlSelect($table, $select, [$where_href, [$other]);
111 # Return: scalar if one element, array if list of elements.
112 # Note: Suitable for one column returns, that is, one column in $select.
113 # Todo: Always return array?
115 my $sth = &sqlSelectMany(@_);
117 &WARN("sqlSelect failed.");
120 my @retval = $sth->fetchrow_array;
123 if (scalar @retval > 1) {
125 } elsif (scalar @retval == 1) {
133 # Usage: &sqlSelectColArray($table, $select, [$where_href], [$other]);
135 sub sqlSelectColArray {
136 my $sth = &sqlSelectMany(@_);
140 &WARN("sqlSelect failed.");
144 while (my @row = $sth->fetchrow_array) {
145 push(@retval, $row[0]);
153 # Usage: &sqlSelectColHash($table, $select, [$where_href], [$other], [$type]);
154 # Return: type = 1: $retval{ col2 }{ col1 } = 1;
155 # Return: no type: $retval{ col1 } = col2;
156 # Note: does not support $other, yet.
157 sub sqlSelectColHash {
158 my ($table, $select, $where_href, $other, $type) = @_;
159 my $sth = &sqlSelectMany($table, $select, $where_href, $other);
161 &WARN("sqlSelectColhash failed.");
166 if (defined $type and $type == 2) {
167 &DEBUG("sqlSelectColHash: type 2!");
168 while (my @row = $sth->fetchrow_array) {
169 $retval{$row[0]} = join(':', $row[1..$#row]);
171 &DEBUG("sqlSelectColHash: count => ".scalar(keys %retval) );
173 } elsif (defined $type and $type == 1) {
174 while (my @row = $sth->fetchrow_array) {
175 # reverse it to make it easier to count.
176 if (scalar @row == 2) {
177 $retval{$row[1]}{$row[0]} = 1;
178 } elsif (scalar @row == 3) {
179 $retval{$row[1]}{$row[0]} = 1;
181 # what to do if there's only one or more than 3?
185 while (my @row = $sth->fetchrow_array) {
186 $retval{$row[0]} = $row[1];
196 # Usage: &sqlSelectRowHash($table, $select, [$where_href]);
197 # Return: $hash{ col } = value;
198 # Note: useful for returning only one/first row of data.
199 sub sqlSelectRowHash {
200 my $sth = &sqlSelectMany(@_);
202 &WARN("sqlSelectRowHash failed.");
205 my $retval = $sth->fetchrow_hashref();
216 # End of SELECT functions.
220 # Usage: &sqlSet($table, $where_href, $data_href);
221 # Return: 1 for success, undef for failure.
223 my ($table, $where_href, $data_href) = @_;
225 if (!defined $table or $table =~ /^\s*$/) {
226 &WARN("sqlSet: table == NULL.");
230 if (!defined $data_href or ref($data_href) ne "HASH") {
231 &WARN("sqlSet: data_href == NULL.");
235 # any column can be NULL... so just get them all.
236 my $k = join(',', keys %{ $where_href } );
237 my $result = &sqlSelect($table, $k, $where_href);
238 # &DEBUG("result is not defined :(") if (!defined $result);
240 # this was hardwired to use sqlUpdate. sqlite does not do inserts on sqlUpdate.
241 if (defined $result) {
242 &sqlUpdate($table, $data_href, $where_href);
245 my %hash = %{ $where_href };
246 # add data_href values...
247 foreach (keys %{ $data_href }) {
248 $hash{ $_ } = ${ $data_href }{$_};
252 &sqlInsert($table, $data_href);
259 # Usage: &sqlUpdate($table, $data_href, $where_href);
261 my ($table, $data_href, $where_href) = @_;
263 if (!defined $data_href or ref($data_href) ne "HASH") {
264 &WARN("sqlSet: data_href == NULL.");
268 my $where = &hashref2where($where_href) if ($where_href);
269 my $update = &hashref2update($data_href) if ($data_href);
271 &sqlRaw("Update", "UPDATE $table SET $update WHERE $where");
277 # Usage: &sqlInsert($table, $data_href, $other);
279 my ($table, $data_href, $other) = @_;
280 # note: if $other == 1, add "DELAYED" to function instead.
282 if (!defined $data_href or ref($data_href) ne "HASH") {
283 &WARN("sqlInsert: data_href == NULL.");
287 my ($k_aref, $v_aref) = &hashref2array($data_href);
288 my @k = @{ $k_aref };
289 my @v = @{ $v_aref };
292 &WARN("sqlInsert: keys or vals is NULL.");
296 return &sqlRaw("Insert($table)", sprintf(
297 "INSERT %s INTO %s (%s) VALUES (%s)",
298 ($other || ""), $table, join(',',@k), join(',',@v)
303 # Usage: &sqlReplace($table, $data_href);
305 my ($table, $data_href) = @_;
307 if (!defined $data_href or ref($data_href) ne "HASH") {
308 &WARN("sqlReplace: data_href == NULL.");
312 my ($k_aref, $v_aref) = &hashref2array($data_href);
313 my @k = @{ $k_aref };
314 my @v = @{ $v_aref };
317 &WARN("sqlReplace: keys or vals is NULL.");
321 &sqlRaw("Replace($table)", sprintf(
322 "REPLACE INTO %s (%s) VALUES (%s)",
323 $table, join(',',@k), join(',',@v)
330 # Usage: &sqlDelete($table, $where_href);
332 my ($table, $where_href) = @_;
334 if (!defined $where_href or ref($where_href) ne "HASH") {
335 &WARN("sqlDelete: where_href == NULL.");
339 my $where = &hashref2where($where_href);
341 &sqlRaw("Delete", "DELETE FROM $table WHERE $where");
347 # Usage: &sqlRaw($prefix, $query);
348 # Return: 1 for success, 0 for failure.
350 my ($prefix, $query) = @_;
353 if (!defined $query or $query =~ /^\s*$/) {
354 &WARN("sqlRaw: query == NULL.");
358 if (!($sth = $dbh->prepare($query))) {
359 &ERROR("Raw($prefix): !prepare => '$query'");
364 if (!$sth->execute) {
365 &ERROR("Raw($prefix): !execute => '$query'");
376 # Usage: &sqlRawReturn($query);
383 if (!defined $query or $query =~ /^\s*$/) {
384 &WARN("sqlRawReturn: query == NULL.");
388 if (!($sth = $dbh->prepare($query))) {
389 &ERROR("RawReturn: !prepare => '$query'");
394 if (!$sth->execute) {
395 &ERROR("RawReturn: !execute => '$query'");
400 while (my @row = $sth->fetchrow_array) {
401 push(@retval, $row[0]);
409 ####################################################################
410 ##### Misc DBI stuff...
416 if (!defined $href) {
417 &WARN("hashref2where: href == NULL.");
421 if (ref($href) ne "HASH") {
422 &WARN("hashref2where: href is not HASH ref (href => $href)");
426 my %hash = %{ $href };
427 foreach (keys %hash) {
430 if (s/^-//) { # as is.
432 delete $hash{'-'.$_};
434 $hash{$_} = &sqlQuote($v);
438 return join(' AND ', map { $_."=".$hash{$_} } keys %hash );
444 if (ref($href) ne "HASH") {
445 &WARN("hashref2update: href is not HASH ref.");
450 foreach (keys %{ $href }) {
452 my $v = ${ $href }{$_};
454 # is there a better way to do this?
455 if ($k =~ s/^-//) { # as is.
464 return join(', ', map { $_."=".$hash{$_} } sort keys %hash);
470 if (ref($href) ne "HASH") {
471 &WARN("hashref2update: href is not HASH ref.");
476 foreach (keys %{ $href }) {
478 my $v = ${ $href }{$_};
480 # is there a better way to do this?
481 if ($k =~ s/^-//) { # as is.
495 # Usage: &countKeys($table, [$col]);
497 my ($table, $col) = @_;
500 return (&sqlRawReturn("SELECT count($col) FROM $table"))[0];
504 # Usage: &sumKey($table, $col);
506 my ($table, $col) = @_;
508 return (&sqlRawReturn("SELECT sum($col) FROM $table"))[0];
512 # Usage: &randKey($table, $select);
514 my ($table, $select) = @_;
515 my $rand = int(rand(&countKeys($table)));
516 my $query = "SELECT $select FROM $table LIMIT 1 OFFSET $rand";
517 if ($param{DBType} =~ /^mysql$/i) {
518 # WARN: only newer MySQL supports "LIMIT limit OFFSET offset"
519 $query = "SELECT $select FROM $table LIMIT $rand,1";
521 my $sth = $dbh->prepare($query);
523 &WARN("randKey($query)") unless $sth->execute;
524 my @retval = $sth->fetchrow_array;
531 # Usage: &deleteTable($table);
533 &sqlRaw("deleteTable($_[0])", "DELETE FROM $_[0]");
537 # Usage: &searchTable($table, $select, $key, $str);
538 # Note: searchTable does sqlQuote.
540 my($table, $select, $key, $str) = @_;
544 # allow two types of wildcards.
545 if ($str =~ /^\^(.*)\$$/) {
546 &FIXME("searchTable: can't do \"$str\"");
549 $str .= "%" if ($str =~ s/^\^//);
550 $str = "%".$str if ($str =~ s/\$$//);
551 $str = "%".$str."%" if ($str eq $origStr); # el-cheapo fix.
555 $str =~ s/\?/_/g; # '.' should be supported, too.
559 my $query = "SELECT $select FROM $table WHERE $key LIKE ".
561 my $sth = $dbh->prepare($query);
564 if (!$sth->execute) {
565 &WARN("Search($query)");
570 while (my @row = $sth->fetchrow_array) {
571 push(@results, $row[0]);
580 my(@path) = ($bot_data_dir, ".","..","../..");
585 my $file = "$_/setup/$table.sql";
586 next unless ( -f $file );
601 &sqlRaw("sqlCreateTable($table)", $data);
607 my $database_exists = 0;
610 if ($param{DBType} =~ /^mysql$/i) {
611 my $sql = "SHOW DATABASES";
612 foreach ( &sqlRawReturn($sql) ) {
613 $database_exists++ if ($_ eq $param{'DBName'});
616 unless ($database_exists) {
617 &status("Creating database $param{DBName}...");
618 my $query = "CREATE DATABASE $param{DBName}";
619 &sqlRaw("create(db $param{DBName})", $query);
622 # retrieve a list of db's from the server.
623 my @tables = map {s/^\`//; s/\`$//; $_;} $dbh->func('_ListTables');
625 @tables = $dbh->tables;
627 &status("Tables: ".join(',',@tables));
628 @db{@tables} = (1) x @tables;
630 } elsif ($param{DBType} =~ /^SQLite(2)?$/i) {
632 # retrieve a list of db's from the server.
633 foreach ( &sqlRawReturn("SELECT name FROM sqlite_master WHERE type='table'") ) {
637 # create database not needed for SQLite
640 foreach ( qw(botmail connections factoids rootwarn seen stats onjoin) ) {
641 if (exists $db{$_}) {
642 $cache{has_table}{$_} = 1;
646 &status("checkTables: creating new table $_...");
648 $cache{create_table}{$_} = 1;