+++ /dev/null
-#
-# db_dbm.pl: Extension on the factoid database.
-# OrigAuthor: Kevin Lenzo (c) 1997
-# CurrAuthor: dms <dms@users.sourceforge.net>
-# Version: v0.6 (20000707)
-# FModified: 19991020
-#
-
-#package main;
-
-if (&::IsParam('useStrict')) { use strict;}
-
-use vars qw(%factoids %freshmeat %seen %rootwarn); # db hash.
-
-{
- my %formats = (
- 'factoids', [
- 'factoid_key',
- 'factoid_value',
- 'created_by',
- 'created_time',
- 'modified_by',
- 'modified_time',
- 'requested_by',
- 'requested_time',
- 'requested_count',
- 'locked_by',
- 'locked_time'
- ],
- 'freshmeat', [
- 'projectname_short',
- 'latest_version',
- 'license',
- 'url_homepage',
- 'desc_short'
- ],
- 'rootwarn', [
- 'nick',
- 'attempt',
- 'time',
- 'host',
- 'channel'
- ],
- 'seen', [
- 'nick',
- 'time',
- 'channel',
- 'host',
- 'messagecount',
- 'hehcount',
- 'karma',
- 'message'
- ],
- 'stats', [
- 'nick',
- 'type',
- 'counter',
- 'time'
- ]
- );
-
- 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;
- }
- } else {
- &::status("DBM $table ($file) disabled.");
- }
- }
- }
-
- sub closeDB {
- foreach (keys %formats) {
- next unless (&::IsParam($_));
-
- if (dbmclose(%{ $_ })) {
- &::status("Closed DBM $_ successfully.");
- next;
- }
- &::ERROR("Failed closing DBM $_.");
- }
- }
-
- #####
- # Usage: &dbGetColInfo($table);
- sub dbGetColInfo {
- my ($table) = @_;
-
- if (scalar @{$formats{$table}}) {
- return @{$formats{$table}};
- } else {
- &::ERROR("dbGCI: no format for table ($table).");
- return;
- }
- }
-}
-
-#####
-# Usage: &dbQuote($str);
-sub dbQuote {
- return $_[0];
-}
-
-#####
-# Usage: &dbGet($table, $select, $where);
-sub dbGet {
- my ($table, $select, $where) = @_;
- my ($key, $val) = split('=',$where) if $where =~ /=/;
- my $found = 0;
- my @retval;
- my $i;
- &::DEBUG("dbGet($table, $select, $where);");
- return unless $key;
-
- my @format = &dbGetColInfo($table);
- if (!scalar @format) {
- return;
- }
-
- if (!defined ${ "$table" }{lc $val}) { # dbm hash exception.
- &::DEBUG("dbGet: '$val' does not exist in $table.");
- return;
- }
-
- # return the whole row.
- if ($select eq "*") {
- @retval = split $;, ${"$table"}{lc $val};
- unshift(@retval,$key);
- return(@retval);
- }
-
- &::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[$_]'.");
- push(@retval, $array[$_]);
- }
-
- if (scalar @retval > 1) {
- return @retval;
- } elsif (scalar @retval == 1) {
- return $retval[0];
- } else {
- return;
- }
-}
-
-#####
-# Usage: &dbGetCol();
-# Usage: &dbGetCol($table, $select, $where, [$type]);
-sub dbGetCol {
- my ($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);");
- my ($key, $val) = split('=',$where) if $where =~ /=/;
- return unless ${$table}{lc $val};
- my (%hash) = ();
- $hash{lc $key} = $val;
- my (@format) = &dbGetColInfo($table);
- shift @format;
- @hash{@format} = split $;, ${$table}{lc $val};
- return %hash;
-}
-
-#####
-# Usage: &dbInsert($table, $primkey, %hash);
-# Note: dbInsert should do dbQuote.
-sub dbInsert {
- my ($table, $primkey, %hash) = @_;
- my $found = 0;
- &::DEBUG("dbInsert($table, $primkey, ...)");
-
- my $info = ${$table}{lc $primkey} || ''; # primkey or primval?
-
- my @format = &dbGetColInfo($table);
- if (!scalar @format) {
- return 0;
- }
-
- my $i;
- my @array = split $;, $info;
- delete $hash{$format[0]};
- for $i (1 .. $#format) {
- my $col = $format[$i];
- $array[$i - 1]=$hash{$col};
- $array[$i - 1]='' unless $array[$i - 1];
- delete $hash{$col};
- &::DEBUG("dbI: '$col'=>'$array[$i - 1]'");
- }
-
- if (scalar keys %hash) {
- &::ERROR("dbI: not added...");
- foreach (keys %hash) {
- &::ERROR("dbI: '$_'=>'$hash{$_}'");
- }
- return 0;
- }
-
- ${$table}{lc $primkey} = join $;, @array;
-
- return 1;
-}
-
-sub dbUpdate {
- &::FIXME("STUB: &dbUpdate(@_);=>somehow use dbInsert!");
-}
-
-#####
-# Usage: &dbSetRow($table, @values);
-sub dbSetRow {
- my ($table, @values) = @_;
- &::DEBUG("dbSetRow(@_);");
- my $key = lc $values[0];
-
- my @format = &dbGetColInfo($table);
- if (!scalar @format) {
- return 0;
- }
-
- if (defined ${$table}{$key}) {
- &::WARN("dbSetRow: $table {$key} already exists?");
- }
-
- if (scalar @values != scalar @format) {
- &::WARN("dbSetRow: scalar values != scalar ${table} format.");
- }
-
- for (0 .. $#format) {
- if (defined $array[$_] and $array[$_] ne "") {
- &::DEBUG("dbSetRow: array[$_] != NULL($array[$_]).");
- }
- $array[$_] = $values[$_];
- }
-
- ${$table}{$key} = join $;, @array;
-}
-
-#####
-# Usage: &dbDel($table, $primkey, $primval, [$key]);
-sub dbDel {
- my ($table, $primkey, $primval, $key) = @_;
- &::DEBUG("dbDel($table, $primkey, $primval);");
-
- if (!defined ${$table}{lc $primval}) {
- &::DEBUG("dbDel: lc $primval does not exist in $table.");
- } else {
- delete ${$table}{lc $primval};
- }
-
- return '';
-}
-
-#####
-# Usage: &dbReplace($table, $key, %hash);
-# Note: dbReplace does optional dbQuote.
-sub dbReplace {
- my ($table, $key, %hash) = @_;
- &::DEBUG("dbReplace($table, $key, %hash);");
-
- &dbDel($table, $key, $hash{$key}, %hash);
- &dbInsert($table, $hash{$key}, %hash);
- return 1;
-}
-
-#####
-# Usage: &dbSet($table, $primhash_ref, $hash_ref);
-sub dbSet {
- my ($table, $phref, $href) = @_;
- &::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}{$_}");
- $hash{$_} = ${$href}{$_};
- }
- &dbReplace($table, $key, %hash);
- return 1;
-}
-
-sub dbRaw {
- &::FIXME("STUB: &dbRaw(@_);");
-}
-
-sub dbRawReturn {
- &::FIXME("STUB: &dbRawReturn(@_);");
-}
-
-
-
-####################################################################
-##### Factoid related stuff...
-#####
-
-sub countKeys {
- return scalar keys %{$_[0]};
-}
-
-sub getKeys {
- return keys %{$_[0]};
-}
-
-sub randKey {
- &::DEBUG("STUB: &randKey(@_);");
- my ($table, $select) = @_;
- my @format = &dbGetColInfo($table);
- if (!scalar @format) {
- return;
- }
-
- my $rand = int(rand(&countKeys($table) - 1));
- my @keys = keys %{$table};
- &dbGet($table, '$select', "$format[0]=$keys[$rand]");
-}
-
-#####
-# Usage: &deleteTable($table);
-sub deleteTable {
- my ($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)");
- return;
- &::DEBUG("searchTable($table, $primkey, $key, $str)");
-
- if (!scalar &dbGetColInfo($table)) {
- return;
- }
-
- my @results;
- foreach (keys %{$table}) {
- my $val = &dbGet($table, "NULL", $_, $key) || '';
- next unless ($val =~ /\Q$str\E/);
- push(@results, $_);
- }
-
- &::DEBUG("sT: ".scalar(@results) );
-
- @results;
-}
-
-#####
-# Usage: &getFactInfo($faqtoid, $type);
-sub getFactInfo {
- my ($faqtoid, $type) = @_;
-
- my @format = &dbGetColInfo("factoids");
- if (!scalar @format) {
- return;
- }
-
- if (!defined $factoids{$faqtoid}) { # dbm hash exception.
- return;
- }
-
- if ($type eq "*") { # all.
- return split /$;/, $factoids{$faqtoid};
- }
-
- # specific.
- if (!grep /^$type$/, @format) {
- &::ERROR("gFI: type '$type' not valid for factoids.");
- return;
- }
-
- my @array = split /$;/, $factoids{$faqtoid};
- for (0 .. $#format) {
- next unless ($type eq $format[$_]);
- return $array[$_];
- }
-
- &::ERROR("gFI: should never happen.");
-}
-
-#####
-# Usage: &getFactoid($faqtoid);
-sub getFactoid {
- my ($faqtoid) = @_;
-
- if (!defined $faqtoid or $faqtoid =~ /^\s*$/) {
- &::WARN("getF: faqtoid == NULL.");
- return;
- }
-
- if (defined $factoids{$faqtoid}) { # dbm hash exception.
- # we assume 1 unfortunately.
- ### TODO: use &getFactInfo() instead?
- my $retval = (split $;, $factoids{$faqtoid})[1];
-
- if (defined $retval) {
- &::DEBUG("getF: returning '$retval' for '$faqtoid'.");
- } else {
- &::DEBUG("getF: returning NULL for '$faqtoid'.");
- }
- return $retval;
- } else {
- return;
- }
-}
-
-#####
-# Usage: &delFactoid($faqtoid);
-sub delFactoid {
- my ($faqtoid) = @_;
-
- if (!defined $faqtoid or $faqtoid =~ /^\s*$/) {
- &::WARN("delF: faqtoid == NULL.");
- return;
- }
-
- if (defined $factoids{$faqtoid}) { # dbm hash exception.
- delete $factoids{$faqtoid};
- &::status("DELETED $faqtoid");
- } else {
- &::WARN("delF: nothing to deleted? ($faqtoid)");
- return;
- }
-}
-
-sub checkTables {
-# nothing - DB_FIle will create them on openDB()
-}
-
-1;
+++ /dev/null
-#
-# db_mysql.pl: MySQL database frontend.
-# Author: dms
-# Version: v0.2c (19991224)
-# Created: 19991203
-#
-
-package main;
-
-if (&IsParam("useStrict")) { use strict; }
-
-#####
-# &openDB($dbname, $sqluser, $sqlpass, $nofail);
-sub openDB {
- my ($db, $user, $pass, $no_fail) = @_;
- my $dsn = "DBI:mysql:$db";
- my $hoststr = "";
- 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");
- } else {
- &ERROR("cannot connect$hoststr.");
- &ERROR("since mysql is not available, shutting down bot!");
- &closePID();
- &closeSHM($shm);
- &closeLog();
-
- return if ($no_fail);
-
- exit 1;
- }
-}
-
-sub closeDB {
- return 0 unless ($dbh);
-
- my $hoststr = "";
- $hoststr = " to $param{'SQLHost'}" if (exists $param{'SQLHost'});
-
- &status("Closed MySQL connection$hoststr.");
- $dbh->disconnect();
-
- return 1;
-}
-
-#####
-# Usage: &dbQuote($str);
-sub dbQuote {
- return $dbh->quote($_[0]);
-}
-
-#####
-# 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 or $select =~ /^\s*$/) {
- &WARN("dbGet: select == NULL.");
- return;
- }
-
- if (!defined $table or $table =~ /^\s*$/) {
- &WARN("dbGet: table == NULL.");
- 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;
-
- 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 = "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;
- }
-
- my @cols;
- while (my @row = $sth->fetchrow_array) {
- push(@cols, $row[0]);
- }
- $sth->finish;
-
- return @cols;
-}
-
-#####
-# 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}
- );
-
- if (!defined $phref) {
- &WARN("dbset: phref == NULL.");
- return;
- }
-
- if (!defined $href) {
- &WARN("dbset: href == NULL.");
- return;
- }
-
- if (!defined $table) {
- &WARN("dbset: table == NULL.");
- return;
- }
-
- 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<scalar @keys; $i++) {
- push(@keyval, $keys[$i]."=".$vals[$i] );
- }
-
- $query = "UPDATE $table SET ".
- join(' AND ', @keyval).
- " WHERE ".$where;
- } else {
- foreach (keys %{$phref}) {
- push(@keys, $_);
- push(@vals, &dbQuote($phref->{$_}) );
- }
-
- $query = sprintf("INSERT INTO $table (%s) VALUES (%s)",
- join(',',@keys), join(',',@vals) );
- }
-
- &dbRaw("Set", $query);
-
- return 1;
-}
-
-#####
-# Usage: &dbUpdate($table, $primkey, $primval, %hash);
-# Note: dbUpdate does dbQuote.
-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, %hash);
-# Note: dbInsert does dbQuote.
-sub dbInsert {
- my ($table, $primkey, %hash, $delay) = @_;
- my (@keys, @vals);
- my $p = "";
-
- if ($delay) {
- &DEBUG("dbI: delay => $delay");
- $p = " DELAYED";
- }
-
- foreach (keys %hash) {
- push(@keys, $_);
- push(@vals, &dbQuote($hash{$_}));
- }
-
- &dbRaw("Insert($table)", "INSERT $p 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);
-
- foreach (keys %hash) {
- if (s/^-//) { # as is.
- push(@keys, $_);
- push(@vals, $hash{'-'.$_});
- } else {
- push(@keys, $_);
- push(@vals, &dbQuote( $hash{$_} ));
- }
- }
-
- if (0) {
- &DEBUG("REPLACE INTO $table (".join(',',@keys).
- ") VALUES (". join(',',@vals). ")" );
- }
-
- &dbRaw("Replace($table)", "REPLACE INTO $table (".join(',',@keys).
- ") VALUES (". join(',',@vals). ")"
- );
-
- return 1;
-}
-
-#####
-# 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;
- }
-
-# &DEBUG("query => '$query'.");
-
- &SQLDebug($query);
- if (!$sth->execute) {
- &ERROR("Raw($prefix): => '$query'");
- # $DBI::errstr is printed as warning automatically.
- $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 $rand,1";
-
- 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.
- $str =~ s/\*/%/g; # for mysql.
- # 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 dbCreateTable {
- my($table) = @_;
- my(@path) = ($bot_data_dir, ".","..","../..");
- my $found = 0;
- my $data;
-
- foreach (@path) {
- my $file = "$_/setup/$table.sql";
- &DEBUG("dbCT: file => $file");
- next unless ( -f $file );
-
- &DEBUG("dbCT: found!!!");
-
- open(IN, $file);
- while (<IN>) {
- chop;
- $data .= $_;
- }
-
- $found++;
- last;
- }
-
- if (!$found) {
- return 0;
- } else {
- &dbRaw("createTable($table)", $data);
- return 1;
- }
-}
-
-sub checkTables {
- my $database_exists = 0;
- foreach ( &dbRawReturn("SHOW DATABASES") ) {
- $database_exists++ if ($_ eq $param{'DBName'});
- }
-
- unless ($database_exists) {
- &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.
- my %db;
- foreach ($dbh->func('_ListTables')) {
- $db{$_} = 1;
- }
-
- # create database.
- if (!scalar keys %db) {
-# &status("Creating database $param{'DBName'}...");
-# $query = "CREATE DATABASE $param{'DBName'}";
-# &dbRaw("create(db $param{'DBName'})", $query);
- }
-
- foreach ("factoids", "freshmeat", "rootwarn", "seen", "stats",
- ) {
- next if (exists $db{$_});
- &status(" creating new table $_...");
-
- &dbCreateTable($_);
- }
-}
-
-1;
+++ /dev/null
-#
-# 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<scalar @keys; $i++) {
- push(@keyval, $keys[$i]."=".$vals[$i] );
- }
-
- $query = "UPDATE $table SET ".
- join(' AND ', @keyval).
- " WHERE $where";
- } else {
- foreach (keys %{$phref}) {
- push(@keys, $_);
- push(@vals, &dbQuote($phref->{$_}) );
- }
-
- $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;
--- /dev/null
+#
+# dbi.pl: DBI (mysql/pgsql/sqlite) database frontend.
+# Author: dms
+# Version: v0.2c (19991224)
+# Created: 19991203
+# Notes: based on db_mysql.pl
+#
+
+use strict;
+
+use vars qw(%param);
+use vars qw($dbh $shm $bot_data_dir);
+
+package main;
+
+#####
+# &openDB($dbname, $dbtype, $sqluser, $sqlpass, $nofail);
+sub openDB {
+ 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 && !$dbh->err) {
+ &status("Opened $type connection$hoststr");
+ } else {
+ &ERROR("cannot connect$hoststr.");
+ &ERROR("since $type is not available, shutting down bot!");
+ &ERROR( $dbh->errstr ) if ($dbh);
+ &closePID();
+ &closeSHM($shm);
+ &closeLog();
+
+ return 0 if ($no_fail);
+
+ exit 1;
+ }
+}
+
+sub closeDB {
+ return 0 unless ($dbh);
+
+ my $x = $param{SQLHost};
+ my $hoststr = ($x) ? " to $x" : "";
+
+ &status("Closed DBI connection$hoststr.");
+ $dbh->disconnect();
+
+ return 1;
+}
+
+#####
+# Usage: &dbQuote($str);
+sub dbQuote {
+ return $dbh->quote($_[0]);
+}
+
+#####
+# 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 or $select =~ /^\s*$/) {
+ &WARN("dbGet: select == NULL.");
+ return;
+ }
+
+ if (!defined $table or $table =~ /^\s*$/) {
+ &WARN("dbGet: table == NULL.");
+ 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;
+
+ 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 = "SHOW COLUMNS from $table";
+ if ($param{DBType} =~ /^pg/i) {
+ $query = "SELECT * FROM $table LIMIT 1";
+ }
+
+ my %retval;
+
+ my $sth = $dbh->prepare($query);
+ &SQLDebug($query);
+ if (!$sth->execute) {
+ &ERROR("GRI => '$query'");
+ &ERROR("GRI => $DBI::errstr");
+ $sth->finish;
+ return;
+ }
+
+ my @cols;
+ while (my @row = $sth->fetchrow_array) {
+ push(@cols, $row[0]);
+ }
+ $sth->finish;
+
+ return @cols;
+}
+
+#####
+# 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}
+ );
+
+ if (!defined $phref) {
+ &WARN("dbset: phref == NULL.");
+ return;
+ }
+
+ if (!defined $href) {
+ &WARN("dbset: href == NULL.");
+ return;
+ }
+
+ if (!defined $table) {
+ &WARN("dbset: table == NULL.");
+ return;
+ }
+
+ 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<scalar @keys; $i++) {
+ push(@keyval, $keys[$i]."=".$vals[$i] );
+ }
+
+ $query = "UPDATE $table SET ".
+ join(' AND ', @keyval).
+ " WHERE ".$where;
+ } else {
+ foreach (keys %{$phref}) {
+ push(@keys, $_);
+ push(@vals, &dbQuote($phref->{$_}) );
+ }
+
+ $query = sprintf("INSERT INTO $table (%s) VALUES (%s)",
+ join(',',@keys), join(',',@vals) );
+ }
+
+ &dbRaw("Set", $query);
+
+ return 1;
+}
+
+#####
+# Usage: &dbUpdate($table, $primkey, $primval, %hash);
+# Note: dbUpdate does dbQuote.
+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, %hash);
+# Note: dbInsert does dbQuote.
+sub dbInsert {
+ my ($table, $primkey, %hash, $delay) = @_;
+ my (@keys, @vals);
+ my $p = "";
+
+ if ($delay) {
+ &DEBUG("dbI: delay => $delay");
+ $p = " DELAYED";
+ }
+
+ foreach (keys %hash) {
+ push(@keys, $_);
+ push(@vals, &dbQuote( $hash{$_} ));
+ }
+
+ &dbRaw("Insert($table)", "INSERT $p 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);
+
+ foreach (keys %hash) {
+ if (s/^-//) { # as is.
+ push(@keys, $_);
+ push(@vals, $hash{'-'.$_});
+ } else {
+ push(@keys, $_);
+ push(@vals, &dbQuote( $hash{$_} ));
+ }
+ }
+
+ # hrm... does pgsql support REPLACE?
+ # if not, well... fuck it.
+ &dbRaw("Replace($table)", "REPLACE INTO $table (".join(',',@keys).
+ ") VALUES (". join(',',@vals). ")"
+ );
+
+ return 1;
+}
+
+#####
+# 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): !prepare => '$query'");
+ return 0;
+ }
+
+ &SQLDebug($query);
+ if (!$sth->execute) {
+ &ERROR("Raw($prefix): !execute => '$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);
+ # 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]);
+ }
+ $sth->finish;
+
+ return @retval;
+}
+
+####################################################################
+##### Misc DBI stuff...
+#####
+
+#####
+# Usage: &countKeys($table, [$col]);
+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) = @_;
+
+ 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 $rand,1";
+ if ($param{DBType} =~ /^pg/i) {
+ $query =~ s/$rand,1/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.
+ $str =~ s/\*/%/g;
+ # 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)");
+ $sth->finish;
+ return;
+ }
+
+ while (my @row = $sth->fetchrow_array) {
+ push(@results, $row[0]);
+ }
+ $sth->finish;
+
+ return @results;
+}
+
+sub dbCreateTable {
+ my($table) = @_;
+ my(@path) = ($bot_data_dir, ".","..","../..");
+ my $found = 0;
+ my $data;
+
+ 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;
+ $data .= $_;
+ }
+
+ $found++;
+ last;
+ }
+
+ if (!$found) {
+ return 0;
+ } else {
+ &dbRaw("dbcreateTable($table)", $data);
+ return 1;
+ }
+}
+
+sub checkTables {
+ my $database_exists = 0;
+ my %db;
+
+ if ($param{DBType} =~ /^mysql$/i) {
+ my $sql = "SHOW DATABASES";
+ foreach ( &dbRawReturn($sql) ) {
+ $database_exists++ if ($_ eq $param{'DBName'});
+ }
+
+ unless ($database_exists) {
+ &status("Creating database $param{DBName}...");
+ my $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 ( qw(factoids freshmeat rootwarn seen stats) ) {
+ next if (exists $db{$_});
+ &status("checkTables: creating new table $_...");
+
+ &dbCreateTable($_);
+ }
+}
+
+1;
--- /dev/null
+#
+# dbm.pl: Extension on the factoid database.
+# OrigAuthor: Kevin Lenzo (c) 1997
+# CurrAuthor: dms <dms@users.sourceforge.net>
+# Version: v0.6 (20000707)
+# FModified: 19991020
+#
+
+use strict;
+
+package main;
+
+use vars qw(%factoids %param);
+
+{
+ my %formats = (
+ 'factoids', [
+ 'factoid_key',
+ 'factoid_value',
+ 'created_by',
+ 'created_time',
+ 'modified_by',
+ 'modified_time',
+ 'requested_by',
+ 'requested_time',
+ 'requested_count',
+ 'locked_by',
+ 'locked_time'
+ ],
+ 'freshmeat', [
+ 'projectname_short',
+ 'latest_version',
+ 'license',
+ 'url_homepage',
+ 'desc_short'
+ ],
+ 'rootwarn', [
+ 'nick',
+ 'attempt',
+ 'time',
+ 'host',
+ 'channel'
+ ],
+ 'seen', [
+ 'nick',
+ 'time',
+ 'channel',
+ 'host',
+ 'messagecount',
+ 'hehcount',
+ 'karma',
+ 'message'
+ ],
+ 'stats', [
+ 'nick',
+ 'type',
+ 'counter',
+ 'time'
+ ]
+ );
+
+ sub openDB {
+ use DB_File;
+ foreach (keys %formats) {
+ next unless (&IsParam($_));
+
+ my $file = "$param{'DBName'}-$_";
+
+ if (dbmopen(%{ $_ }, $file, 0666)) {
+ &status("Opened DBM $_ ($file).");
+ } else {
+ &ERROR("Failed open to DBM $_ ($file).");
+ &shutdown();
+ exit 1;
+ }
+ }
+ }
+
+ sub closeDB {
+ foreach (keys %formats) {
+ next unless (&IsParam($_));
+
+ if (dbmclose(%{ $_ })) {
+ &status("Closed DBM $_ successfully.");
+ next;
+ }
+ &ERROR("Failed closing DBM $_.");
+ }
+ }
+
+ #####
+ # Usage: &dbGetColInfo($table);
+ sub dbGetColInfo {
+ my ($table) = @_;
+
+ if (scalar @{$formats{$table}}) {
+ return @{$formats{$table}};
+ } else {
+ &ERROR("dbGCI: no format for table ($table).");
+ return;
+ }
+ }
+}
+
+#####
+# Usage: &dbQuote($str);
+sub dbQuote {
+ return $_[0];
+}
+
+#####
+# Usage: &dbGet($table, $select, $where);
+sub dbGet {
+ my ($table, $select, $where) = @_;
+ my ($key, $val) = split('=',$where) if $where =~ /=/;
+ my $found = 0;
+ my @retval;
+ my $i;
+ &DEBUG("dbGet($table, $select, $where);");
+ return unless $key;
+
+ my @format = &dbGetColInfo($table);
+ if (!scalar @format) {
+ return;
+ }
+
+ if (!defined ${ "$table" }{lc $val}) { # dbm hash exception.
+ &DEBUG("dbGet: '$val' does not exist in $table.");
+ return;
+ }
+
+ # return the whole row.
+ if ($select eq "*") {
+ @retval = split $;, ${"$table"}{lc $val};
+ unshift(@retval,$key);
+ return(@retval);
+ }
+
+ &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[$_]'.");
+ push(@retval, $array[$_]);
+ }
+
+ if (scalar @retval > 1) {
+ return @retval;
+ } elsif (scalar @retval == 1) {
+ return $retval[0];
+ } else {
+ return;
+ }
+}
+
+#####
+# Usage: &dbGetCol();
+# Usage: &dbGetCol($table, $select, $where, [$type]);
+sub dbGetCol {
+ my ($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);");
+ my ($key, $val) = split('=',$where) if $where =~ /=/;
+ return unless ${$table}{lc $val};
+ my (%hash) = ();
+ $hash{lc $key} = $val;
+ my (@format) = &dbGetColInfo($table);
+ shift @format;
+ @hash{@format} = split $;, ${$table}{lc $val};
+ return %hash;
+}
+
+#####
+# Usage: &dbInsert($table, $primkey, %hash);
+# Note: dbInsert should do dbQuote.
+sub dbInsert {
+ my ($table, $primkey, %hash) = @_;
+ my $found = 0;
+ &DEBUG("dbInsert($table, $primkey, ...)");
+
+ my $info = ${$table}{lc $primkey} || ''; # primkey or primval?
+
+ my @format = &dbGetColInfo($table);
+ if (!scalar @format) {
+ return 0;
+ }
+
+ my $i;
+ my @array = split $;, $info;
+ delete $hash{$format[0]};
+ for $i (1 .. $#format) {
+ my $col = $format[$i];
+ $array[$i - 1]=$hash{$col};
+ $array[$i - 1]='' unless $array[$i - 1];
+ delete $hash{$col};
+ &DEBUG("dbI: '$col'=>'$array[$i - 1]'");
+ }
+
+ if (scalar keys %hash) {
+ &ERROR("dbI: not added...");
+ foreach (keys %hash) {
+ &ERROR("dbI: '$_'=>'$hash{$_}'");
+ }
+ return 0;
+ }
+
+ ${$table}{lc $primkey} = join $;, @array;
+
+ return 1;
+}
+
+sub dbUpdate {
+ &FIXME("STUB: &dbUpdate(@_);=>somehow use dbInsert!");
+}
+
+#####
+# Usage: &dbSetRow($table, @values);
+sub dbSetRow {
+ my ($table, @values) = @_;
+ &DEBUG("dbSetRow(@_);");
+ my $key = lc $values[0];
+
+ my @format = &dbGetColInfo($table);
+ if (!scalar @format) {
+ return 0;
+ }
+
+ if (defined ${$table}{$key}) {
+ &WARN("dbSetRow: $table {$key} already exists?");
+ }
+
+ if (scalar @values != scalar @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[$_]).");
+ }
+ $array[$_] = $values[$_];
+ }
+
+ ${$table}{$key} = join $;, @array;
+}
+
+#####
+# Usage: &dbDel($table, $primkey, $primval, [$key]);
+sub dbDel {
+ my ($table, $primkey, $primval, $key) = @_;
+ &DEBUG("dbDel($table, $primkey, $primval);");
+
+ if (!defined ${$table}{lc $primval}) {
+ &DEBUG("dbDel: lc $primval does not exist in $table.");
+ } else {
+ delete ${$table}{lc $primval};
+ }
+
+ return '';
+}
+
+#####
+# Usage: &dbReplace($table, $key, %hash);
+# Note: dbReplace does optional dbQuote.
+sub dbReplace {
+ my ($table, $key, %hash) = @_;
+ &DEBUG("dbReplace($table, $key, %hash);");
+
+ &dbDel($table, $key, $hash{$key}, %hash);
+ &dbInsert($table, $hash{$key}, %hash);
+ return 1;
+}
+
+#####
+# Usage: &dbSet($table, $primhash_ref, $hash_ref);
+sub dbSet {
+ my ($table, $phref, $href) = @_;
+ &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}{$_}");
+ $hash{$_} = ${$href}{$_};
+ }
+ &dbReplace($table, $key, %hash);
+ return 1;
+}
+
+sub dbRaw {
+ &FIXME("STUB: &dbRaw(@_);");
+}
+
+sub dbRawReturn {
+ &FIXME("STUB: &dbRawReturn(@_);");
+}
+
+
+
+####################################################################
+##### Factoid related stuff...
+#####
+
+sub countKeys {
+ return scalar keys %{$_[0]};
+}
+
+sub getKeys {
+ &FIXME("STUB: &getKeys(@_); -- REDUNDANT");
+}
+
+sub randKey {
+ &DEBUG("STUB: &randKey(@_);");
+ my ($table, $select) = @_;
+ my @format = &dbGetColInfo($table);
+ if (!scalar @format) {
+ return;
+ }
+
+ my $rand = int(rand(&countKeys($table) - 1));
+ my @keys = keys %{$table};
+ &dbGet($table, '$select', "$format[0]=$keys[$rand]");
+}
+
+#####
+# Usage: &deleteTable($table);
+sub deleteTable {
+ my ($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)");
+ return;
+ &DEBUG("searchTable($table, $primkey, $key, $str)");
+
+ if (!scalar &dbGetColInfo($table)) {
+ return;
+ }
+
+ my @results;
+ foreach (keys %{$table}) {
+ my $val = &dbGet($table, "NULL", $_, $key) || '';
+ next unless ($val =~ /\Q$str\E/);
+ push(@results, $_);
+ }
+
+ &DEBUG("sT: ".scalar(@results) );
+
+ @results;
+}
+
+#####
+# Usage: &getFactInfo($faqtoid, $type);
+sub getFactInfo {
+ my ($faqtoid, $type) = @_;
+
+ my @format = &dbGetColInfo("factoids");
+ if (!scalar @format) {
+ return;
+ }
+
+ if (!defined $factoids{$faqtoid}) { # dbm hash exception.
+ return;
+ }
+
+ if ($type eq "*") { # all.
+ return split /$;/, $factoids{$faqtoid};
+ }
+
+ # specific.
+ if (!grep /^$type$/, @format) {
+ &ERROR("gFI: type '$type' not valid for factoids.");
+ return;
+ }
+
+ my @array = split /$;/, $factoids{$faqtoid};
+ for (0 .. $#format) {
+ next unless ($type eq $format[$_]);
+ return $array[$_];
+ }
+
+ &ERROR("gFI: should never happen.");
+}
+
+#####
+# Usage: &getFactoid($faqtoid);
+sub getFactoid {
+ my ($faqtoid) = @_;
+
+ if (!defined $faqtoid or $faqtoid =~ /^\s*$/) {
+ &WARN("getF: faqtoid == NULL.");
+ return;
+ }
+
+ if (defined $factoids{$faqtoid}) { # dbm hash exception.
+ # we assume 1 unfortunately.
+ ### TODO: use &getFactInfo() instead?
+ my $retval = (split $;, $factoids{$faqtoid})[1];
+
+ if (defined $retval) {
+ &DEBUG("getF: returning '$retval' for '$faqtoid'.");
+ } else {
+ &DEBUG("getF: returning NULL for '$faqtoid'.");
+ }
+ return $retval;
+ } else {
+ return;
+ }
+}
+
+#####
+# Usage: &delFactoid($faqtoid);
+sub delFactoid {
+ my ($faqtoid) = @_;
+
+ if (!defined $faqtoid or $faqtoid =~ /^\s*$/) {
+ &WARN("delF: faqtoid == NULL.");
+ return;
+ }
+
+ if (defined $factoids{$faqtoid}) { # dbm hash exception.
+ delete $factoids{$faqtoid};
+ &status("DELETED $faqtoid");
+ } else {
+ &WARN("delF: nothing to deleted? ($faqtoid)");
+ return;
+ }
+}
+
+sub checkTables {
+# nothing - DB_FIle will create them on openDB()
+}
+
+1;
projects / infobot.git / commitdiff