From b28802c40e8775f2a9457b833e2014ccc2f4161c Mon Sep 17 00:00:00 2001 From: timriker Date: Sat, 7 Dec 2002 04:26:36 +0000 Subject: [PATCH] remove Berkeley DBM support git-svn-id: https://svn.code.sf.net/p/infobot/code/trunk/blootbot@739 c11ca15a-4712-0410-83d8-924469b57eb5 --- INSTALL | 1 - INSTALL.dbm | 14 - README | 2 +- files/sample/sample.config | 3 +- files/sample/sample.config.broken | 5 +- src/Factoids/Statement.pl | 2 +- src/IRC/Schedulers.pl | 16 +- src/Modules/Countdown.pl | 9 +- src/Modules/UserDCC.pl | 2 +- src/Modules/botmail.pl | 5 - src/Process.pl | 2 +- src/dbm.pl | 445 ------------------------------ src/modules.pl | 43 +-- 13 files changed, 14 insertions(+), 535 deletions(-) delete mode 100644 INSTALL.dbm delete mode 100644 src/dbm.pl diff --git a/INSTALL b/INSTALL index 560cbdb..373153f 100644 --- a/INSTALL +++ b/INSTALL @@ -24,7 +24,6 @@ Method of installation. - MySQL, read INSTALL.mysql (supported) - SQLite, read INSTALL.sqlite (supported) - PgSQL, read INSTALL.pgsql (unsupported, may work) - - Berkeley DBM, read INSTALL.dbm (unsupported, may work) - There are "bugs" in the perl modules. Read INSTALL.patches on how to fix. diff --git a/INSTALL.dbm b/INSTALL.dbm deleted file mode 100644 index 02d9c4c..0000000 --- a/INSTALL.dbm +++ /dev/null @@ -1,14 +0,0 @@ -INSTALLATION of dbm ----------------------- - -- perl5.004 uses dbm1.85 while perl5.005 uses dbm2.00. Attempting to - interchange dbm between the two will result in corruption. -- the dbm will produce two files of the same size (for some reason) -- If the bot crashes, the dbm file may increase in size dramatically, from - 900k-1400k to 16m-24m -- dbm is a slow but simple form of db. If you want performance, try mysql - or sqlite (NOT SUPPORTED) or pgsql (NOT YET) - -= To convert dbm file to mysql table: - - run 'scripts/dbm2mysql.pl old-db' to convert dbm database file - to mysql. diff --git a/README b/README index b923d69..092e416 100644 --- a/README +++ b/README @@ -117,7 +117,7 @@ through DCC CHAT. /chat . All commands must be prepended by - User Information Services. - new wingate caching/file-read code. - disabling IRC/factoid support code. - - PG/DBM supports need to be worked and thoroughly tested. + - PG supports need to be worked and thoroughly tested. CONTRIBUTIONS diff --git a/files/sample/sample.config b/files/sample/sample.config index ed55ff1..fbf9f02 100644 --- a/files/sample/sample.config +++ b/files/sample/sample.config @@ -31,11 +31,10 @@ set tempDir /home/blootbot/Temp # mysql -- ... # SQLite -- SQLite (libdbd-sqlite-perl) # pgsql -- postgresql (NOT SUPPORTED) -# dbm -- berkeley dbm ### REQUIRED by factoids,freshmeat,karma,seen,... set DBType mysql -# [str] DBM/SQLite filename prefix // MYSQL/PGSQL database. +# [str] SQLite filename prefix // MYSQL/PGSQL database. # eg: blootbot-factoids, blootbot-seen # eg: /var/db/mysql/blootbot/factoids.* set DBName blootbot diff --git a/files/sample/sample.config.broken b/files/sample/sample.config.broken index d43fa1c..11c684d 100644 --- a/files/sample/sample.config.broken +++ b/files/sample/sample.config.broken @@ -45,13 +45,12 @@ set maxLogSize 10000000 # [str] Ability to remember/tell factoids # none -- disable. # mysql -- MySQL -# sqlite -- SQLite (libdbd-sqlite-perl) +# SQLite -- SQLite (libdbd-sqlite-perl) # pgsql -- PostGreSQL (NOT SUPPORTED YET) -# dbm -- Berkeley DBM ### REQUIRED by factoids,freshmeat,karma,seen,... set DBType mysql -# [str] DBM filename prefix // MYSQL/PGSQL database. +# [str] SQLite filename prefix // MYSQL/PGSQL database. # eg: blootbot-factoids, blootbot-seen # eg: /var/db/mysql/blootbot/factoids.* set DBName blootbot diff --git a/src/Factoids/Statement.pl b/src/Factoids/Statement.pl index f689fc8..b02a4da 100644 --- a/src/Factoids/Statement.pl +++ b/src/Factoids/Statement.pl @@ -6,7 +6,7 @@ ## doStatement -- ## ## decide if $in is a statement, and if so, -## - update the dbm +## - update the db ## - return feedback statement ## ## otherwise return diff --git a/src/IRC/Schedulers.pl b/src/IRC/Schedulers.pl index f0e918c..3172e0b 100644 --- a/src/IRC/Schedulers.pl +++ b/src/IRC/Schedulers.pl @@ -305,20 +305,8 @@ sub seenFlushOld { } $sth->finish; } - } elsif ($param{'DBType'} =~ /^dbm/i) { - my $time = time(); - - foreach (keys %seen) { - my $t2 = &sqlSelect("seen", "time", { nick => $_ }) || 0; - my $delta_time = $time - $t2; - next unless ($delta_time > $max_time); - - &DEBUG("seenFlushOld: ".&Time2String($delta_time) ); - delete $seen{$_}; - $delete++; - } } else { - &FIXME("seenFlushOld: for PG/NO-DB."); + &FIXME("seenFlushOld: for bad DBType:" . $param{'DBType'} . "."); } &VERB("SEEN deleted $delete seen entries.",2); @@ -588,7 +576,7 @@ sub seenFlush { $stats{'new'} = 0; $stats{'old'} = 0; - if ($param{'DBType'} =~ /^(mysql|pgsql|sqlite|dbm)$/i) { + if ($param{'DBType'} =~ /^(mysql|pgsql|sqlite)$/i) { foreach $nick (keys %seencache) { my $retval = &sqlReplace("seen", { nick => lc $seencache{$nick}{'nick'}, diff --git a/src/Modules/Countdown.pl b/src/Modules/Countdown.pl index 162e395..5a11948 100644 --- a/src/Modules/Countdown.pl +++ b/src/Modules/Countdown.pl @@ -55,15 +55,8 @@ sub Countdown { $dayname = qw(Sun Mon Tue Wed Thu Fri Sat)[(&sqlRawReturn("SELECT extract(dow from timestamp '$sqldate')"))[0]]; $monname = qw(BAD Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec)[(&sqlRawReturn("SELECT extract(month from timestamp '$sqldate')"))[0]]; - } elsif ($param{'DBType'} =~ /^dbm$/i) { - &FIXME("Countdown: no dbm support"); -# $to_days = -# $dayname = -# $monname = - return 1; - } else { - &ERROR("Countdown: invalid DBType?"); + &ERROR("Countdown: invalid DBType " . $param{'DBType'} . "."); return 1; } diff --git a/src/Modules/UserDCC.pl b/src/Modules/UserDCC.pl index 49c10f0..f91e1b1 100644 --- a/src/Modules/UserDCC.pl +++ b/src/Modules/UserDCC.pl @@ -365,7 +365,7 @@ sub userDCC { return; } - ### TODO: fix up $op to support mysql/sqlite/pgsql/dbm(perl) + ### TODO: fix up $op to support mysql/sqlite/pgsql ### TODO: => add db/sql specific function to fix this. my @list = &searchTable("factoids", "factoid_key", "factoid_value", $op); diff --git a/src/Modules/botmail.pl b/src/Modules/botmail.pl index c0ecab5..0439f27 100644 --- a/src/Modules/botmail.pl +++ b/src/Modules/botmail.pl @@ -14,11 +14,6 @@ use strict; sub parse { my($what) = @_; - if ($::param{'DBType'} =~ /^dbm/i) { - # FIXME multi field indexed tables not supported under dbm - &::msg($::who, "botmail disabled for $::param{'DBType'}"); - return; - } if (!defined $what or $what =~ /^\s*$/) { &::help("botmail"); return; diff --git a/src/Process.pl b/src/Process.pl index 3563866..abe7d18 100644 --- a/src/Process.pl +++ b/src/Process.pl @@ -359,7 +359,7 @@ sub process { } } - if (&IsParam("factoids") and $param{'DBType'} =~ /^(mysql|sqlite|pgsql|dbm)/i) { + if (&IsParam("factoids") and $param{'DBType'} =~ /^(mysql|sqlite|pgsql)/i) { &FactoidStuff(); } elsif ($param{'DBType'} =~ /^none$/i) { return "NO FACTOIDS."; diff --git a/src/dbm.pl b/src/dbm.pl deleted file mode 100644 index 0048143..0000000 --- a/src/dbm.pl +++ /dev/null @@ -1,445 +0,0 @@ -# -# dbm.pl: Extension on the factoid database. -# OrigAuthor: Kevin Lenzo (c) 1997 -# CurrAuthor: dms -# Version: v0.6 (20000707) -# FModified: 19991020 -# - -use strict; -no strict 'refs'; - -package main; - -use vars qw(%factoids %param); - -{ - # FIXME we don't handle multiply indexes tables - # perhaps we should combine the keys with a ':' or something? - # the spaces below separate the keys from the rest - # of the fields. - # Tim Riker thinks that freshmeat below should be a single index - my %formats = ( - 'factoids', [ - 'factoid_key', - - 'requested_by', - 'requested_time', - 'requested_count', - 'created_by', - 'created_time', - 'modified_by', - 'modified_time', - 'locked_by', - 'locked_time', - 'factoid_value' - ], - 'freshmeat', [ - 'projectname_short', - 'latest_version', - - 'license', - 'url_homepage', - 'desc_short' - ], - 'rootwarn', [ - 'nick', - - 'attempt', - 'time', - 'host', - 'channel' - ], - 'seen', [ - 'nick', - - 'time', - 'channel', - 'host', - 'message' - ], - 'stats', [ - 'nick', - 'type', - 'channel', - - 'time', - 'counter' - ], - 'botmail', [ - 'srcwho', - 'dstwho', - - 'srcuh', - 'time', - 'msg' - ] - ); - - sub openDB { - use DB_File; - foreach my $table (keys %formats) { - next unless (&IsParam($table)); - - my $file = "$param{'DBName'}-$table"; - - if (dbmopen(%{"$table"}, $file, 0666)) { - &status("Opened DBM $table ($file)."); - } else { - &ERROR("Failed open to DBM $table ($file)."); - &shutdown(); - exit 1; - } - } - } - - sub closeDB { - foreach my $table (keys %formats) { - next unless (&IsParam($table)); - - if (dbmclose(%{ $table })) { - &status("Closed DBM $table successfully."); - next; - } - &ERROR("Failed closing DBM $table."); - } - } - - ##### - # 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); - } - - # FIXME this should be in $select order - # and it's now in field order - &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 { - &FIXME("STUB: &dbSetRow(@_)"); -} - -##### -# Usage: &dbDel($table, $primhash_ref); -# Note: dbDel does dbQuote -sub dbDel { - my ($table, $phref) = @_; - # FIXME does not really handle more than one key! - my $primval = join(':', values %{$phref}); - - 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}}); - &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; diff --git a/src/modules.pl b/src/modules.pl index 5a8a209..278e673 100644 --- a/src/modules.pl +++ b/src/modules.pl @@ -89,53 +89,18 @@ sub loadDBModules { my $f; # todo: use function to load module. - if ($param{'DBType'} =~ /^mysql$/i) { + if ($param{'DBType'} =~ /^(mysql|SQLite|pgsql)$/i) { eval "use DBI"; if ($@) { - &ERROR("libdbd-mysql-perl is not installed!"); + &ERROR("No support for DBI::" . $param{'DBType'} . ", exiting!"); exit 1; } - &status("Loading MySQL support."); + &status("Loading " . $param{'DBType'} . " support."); $f = "$bot_src_dir/dbi.pl"; require $f; $moduleAge{$f} = (stat $f)[9]; - &showProc(" (DBI::mysql)"); - - } elsif ($param{'DBType'} =~ /^pgsql$/i) { - eval "use DBI"; - if ($@) { - &ERROR("libpgperl is not installed!"); - exit 1; - } - &status("Loading pgsql support."); - $f = "$bot_src_dir/dbi.pl"; - require $f; - $moduleAge{$f} = (stat $f)[9]; - - &showProc(" (DBI::pgsql)"); - - } elsif ($param{'DBType'} =~ /^sqlite$/i) { - eval "use DBI"; - if ($@) { - &ERROR("libdbd-sqlite-perl is not installed!"); - exit 1; - } - &status("Loading SQLite support."); - $f = "$bot_src_dir/dbi.pl"; - require $f; - $moduleAge{$f} = (stat $f)[9]; - - &showProc(" (DBI::SQLite)"); - - } elsif ($param{'DBType'} =~ /^dbm$/i) { - &status("Loading dbm support."); - $f = "$bot_src_dir/dbm.pl"; - require $f; - $moduleAge{$f} = (stat $f)[9]; - - &showProc(" (dbm.pl)"); - + &showProc(" (DBI::" . $param{'DBType'} . ")"); } else { &WARN("DB support DISABLED."); return; -- 2.39.2