From 99f86352e2eff21f5eef65c16c41b44e1bfa17b6 Mon Sep 17 00:00:00 2001 From: dms Date: Tue, 29 Oct 2002 15:02:18 +0000 Subject: [PATCH] - berkeley dbm support now works! thanks to tim riker. - moved shmFlush(),getChanConfDefault out of Scheduler.pl to where they should belong, to allow CLI support without need of IRC/*.pl. - disable seen/dcc if interface is not IRC. - Debian: unlink file if it's corrupted. git-svn-id: https://svn.code.sf.net/p/infobot/code/trunk/blootbot@560 c11ca15a-4712-0410-83d8-924469b57eb5 --- src/CLI/Support.pl | 43 ++++++ src/CommandStubs.pl | 5 + src/Factoids/Update.pl | 6 +- src/IRC/Irc.pl | 5 +- src/IRC/IrcHelpers.pl | 2 +- src/IRC/IrcHooks.pl | 5 + src/IRC/Schedulers.pl | 67 ---------- src/Modules/Debian.pl | 13 +- src/Shm.pl | 46 ++++++- src/UserExtra.pl | 7 +- src/core.pl | 25 +++- src/db_dbm.pl | 287 ++++++++++++++++++++++++++--------------- src/db_mysql.pl | 4 +- src/interface.pl | 7 +- src/logger.pl | 2 +- src/modules.pl | 23 ++-- 16 files changed, 348 insertions(+), 199 deletions(-) create mode 100644 src/CLI/Support.pl diff --git a/src/CLI/Support.pl b/src/CLI/Support.pl new file mode 100644 index 0000000..b3c7b1a --- /dev/null +++ b/src/CLI/Support.pl @@ -0,0 +1,43 @@ +# +# CLI/Support.pl: Stubs for functions that are from IRC/* +# Author: Tim Riker +# Version: v0.1 (20021028) +# Created: 20021028 +# + +sub msg { + my ($nick, $msg) = @_; + if (!defined $nick) { + &ERROR("msg: nick == NULL."); + return; + } + + if (!defined $msg) { + $msg ||= "NULL"; + &WARN("msg: msg == $msg."); + return; + } + + &status(">$nick< $msg"); + + print("$nick: $msg\n"); +} + +sub performStrictReply { + &msg($who, @_); +} + +sub performReply { + &msg($who, @_); +} + +sub performAddressedReply { + return unless ($addressed); + &msg($who, @_); +} + +sub pSReply { + &msg($who, @_); +} + +1; diff --git a/src/CommandStubs.pl b/src/CommandStubs.pl index 39833b5..7aec2a6 100644 --- a/src/CommandStubs.pl +++ b/src/CommandStubs.pl @@ -575,6 +575,11 @@ sub seen { my($person) = lc shift; $person =~ s/\?*$//; + if (&whatInterface() !~ /IRC/) { + &status("seen disabled in CLI."); + return; + } + if (!defined $person or $person =~ /^$/) { &help("seen"); diff --git a/src/Factoids/Update.pl b/src/Factoids/Update.pl index d0b57d1..07b8ec6 100644 --- a/src/Factoids/Update.pl +++ b/src/Factoids/Update.pl @@ -224,9 +224,9 @@ sub update { &status("update: <$who> \'$lhs\' =$mhs=> \'$rhs\'; was \'$exists\'"); # should dbReplace be used here? - &delFactoid($lhs); - &setFactInfo($lhs,"created_by", $nuh); - &setFactInfo($lhs,"created_time", time()); + #&delFactoid($lhs); # breaks dbm. leave it and use modified_* - Tim Riker + &setFactInfo($lhs,"modified_by", $nuh); + &setFactInfo($lhs,"modified_time", time()); &setFactInfo($lhs,"factoid_value", $rhs); if (!defined $rhs or $rhs eq "") { diff --git a/src/IRC/Irc.pl b/src/IRC/Irc.pl index 49d0438..cdc98fa 100644 --- a/src/IRC/Irc.pl +++ b/src/IRC/Irc.pl @@ -604,7 +604,8 @@ sub nick { if ($bad) { &WARN("Nick: not going to try and get my nick back. [". scalar(localtime). "]"); - return; +# hrm... over time we lose track of our own nick. +# return; } if ($nick =~ /^$mask{nick}$/) { @@ -612,6 +613,8 @@ sub nick { if (defined $ident) { &status("nick: Changing nick to $nick (from $ident)"); + # following shouldn't be here :( + $ident = $nick; } else { &DEBUG("first time nick change."); $ident = $nick; diff --git a/src/IRC/IrcHelpers.pl b/src/IRC/IrcHelpers.pl index 2ce1acb..53d3db7 100644 --- a/src/IRC/IrcHelpers.pl +++ b/src/IRC/IrcHelpers.pl @@ -244,7 +244,7 @@ sub hookMsg { # better to ignore an extra message than to allow one to get # through, although it would be better to go through ignore # checking again. - if (time() - $cache{ignoreCheckTime} > 60) { + if (time() - ($cache{ignoreCheckTime} || 0) > 60) { &ignoreCheck(); } diff --git a/src/IRC/IrcHooks.pl b/src/IRC/IrcHooks.pl index 125ba7c..8370a21 100644 --- a/src/IRC/IrcHooks.pl +++ b/src/IRC/IrcHooks.pl @@ -459,6 +459,11 @@ sub on_join { my $i = scalar(keys %{ $channels{$chan} }); my $j = $cache{maxpeeps}{$chan} || 0; + if (time() > $sched{shmFlush}{TIME} + 3600) { + &DEBUG("looks like schedulers died somewhere... restarting..."); + &setupSchedulers(); + } + $chanstats{$chan}{'Join'}++; $userstats{lc $who}{'Join'} = time() if (&IsChanConf("seenStats")); $cache{maxpeeps}{$chan} = $i if ($i > $j); diff --git a/src/IRC/Schedulers.pl b/src/IRC/Schedulers.pl index 2274247..7ce4284 100644 --- a/src/IRC/Schedulers.pl +++ b/src/IRC/Schedulers.pl @@ -875,49 +875,6 @@ sub miscCheck2 { closedir DIR; } -sub shmFlush { - return if ($$ != $::bot_pid); # fork protection. - - if (@_) { - &ScheduleThis(5, "shmFlush"); - return if ($_[0] eq "2"); - } - - my $time; - my $shmmsg = &shmRead($shm); - $shmmsg =~ s/\0//g; # remove padded \0's. - if ($shmmsg =~ s/^(\d+): //) { - $time = $1; - } - - foreach (split '\|\|', $shmmsg) { - next if (/^$/); - &VERB("shm: Processing '$_'.",2); - - if (/^DCC SEND (\S+) (\S+)$/) { - my ($nick,$file) = ($1,$2); - if (exists $dcc{'SEND'}{$who}) { - &msg($nick, "DCC already active."); - } else { - &DEBUG("shm: dcc sending $2 to $1."); - $conn->new_send($1,$2); - $dcc{'SEND'}{$who} = time(); - } - } elsif (/^SET FORKPID (\S+) (\S+)/) { - $forked{$1}{PID} = $2; - } elsif (/^DELETE FORK (\S+)$/) { - delete $forked{$1}; - } elsif (/^EVAL (.*)$/) { - &DEBUG("evaling '$1'."); - eval $1; - } else { - &DEBUG("shm: unknown msg. ($_)"); - } - } - - &shmWrite($shm,"") if ($shmmsg ne ""); -} - ### this is semi-scheduled sub getNickInUse { if ($ident eq $param{'ircNick'}) { @@ -1176,30 +1133,6 @@ sub scheduleList { &DEBUG("end of sList."); } -sub getChanConfDefault { - my($what, $default, $chan) = @_; - - if (exists $param{$what}) { - if (!exists $cache{config}{$what}) { - &status("conf: backward-compat: found param{$what} ($param{$what}) instead."); - $cache{config}{$what} = 1; - } - - return $param{$what}; - } - - my $val = &getChanConf($what, $chan); - if (defined $val) { - return $val; - } - - $param{$what} = $default; - &status("conf: auto-setting param{$what} = $default"); - $cache{config}{$what} = 1; - - return $default; -} - sub mkBackup { my($file, $time) = @_; my $backup = 0; diff --git a/src/Modules/Debian.pl b/src/Modules/Debian.pl index 8cd663e..d4f1576 100644 --- a/src/Modules/Debian.pl +++ b/src/Modules/Debian.pl @@ -140,6 +140,13 @@ sub DebianDownload { # system("cp debian/Contents-potato-i386-non-US.gz debian/Contents-woody-i386-non-US.gz"); # } + my $exit = CORE::system("/bin/gzip -t $file >/dev/null 2>&1"); + if ($exit) { + &::WARN("deb: $file is corrupted :/"); + unlink $file; + next; + } + &::DEBUG("deb: download: good.") if ($debug); $good++; } else { @@ -150,7 +157,7 @@ sub DebianDownload { } # ok... lets just run this. - &::miscCheck(); + &::miscCheck() if (&::whatInterface() =~ /IRC/); if ($good) { &generateIndex($dist); @@ -394,6 +401,7 @@ sub searchAuthor { $package = ""; } else { + chop; &::WARN("debian: invalid line: '$_' (1)."); } } @@ -503,6 +511,7 @@ sub searchDesc { $package = ""; } else { + chop; &::WARN("debian: invalid line: '$_'. (2)"); } } @@ -589,7 +598,7 @@ sub getPackageInfo { # package line. if (/^Package: (.*)\n$/) { $pkg = $1; - if ($pkg =~ /^$package$/i) { + if ($pkg =~ /^\Q$package\E$/i) { $found++; # we can use pkg{'package'} instead. $pkg{'package'} = $pkg; } diff --git a/src/Shm.pl b/src/Shm.pl index 34b68f2..ab7e996 100644 --- a/src/Shm.pl +++ b/src/Shm.pl @@ -5,7 +5,6 @@ # Created: 20000124 # -#use strict; use POSIX qw(_exit); sub openSHM { @@ -13,7 +12,7 @@ sub openSHM { my $size = 2000; if (&IsParam("noSHM")) { - &status("Created shared memory: disabled. [bot may become unreliable]"); + &status("Created shared memory: disabled. [bot may become unreliable]"); return 0; } @@ -216,4 +215,47 @@ sub delForked { POSIX::_exit(0); } +sub shmFlush { + return if ($$ != $::bot_pid); # fork protection. + + if (@_) { + &ScheduleThis(5, "shmFlush"); + return if ($_[0] eq "2"); + } + + my $time; + my $shmmsg = &shmRead($shm); + $shmmsg =~ s/\0//g; # remove padded \0's. + if ($shmmsg =~ s/^(\d+): //) { + $time = $1; + } + + foreach (split '\|\|', $shmmsg) { + next if (/^$/); + &VERB("shm: Processing '$_'.",2); + + if (/^DCC SEND (\S+) (\S+)$/) { + my ($nick,$file) = ($1,$2); + if (exists $dcc{'SEND'}{$who}) { + &msg($nick, "DCC already active."); + } else { + &DEBUG("shm: dcc sending $2 to $1."); + $conn->new_send($1,$2); + $dcc{'SEND'}{$who} = time(); + } + } elsif (/^SET FORKPID (\S+) (\S+)/) { + $forked{$1}{PID} = $2; + } elsif (/^DELETE FORK (\S+)$/) { + delete $forked{$1}; + } elsif (/^EVAL (.*)$/) { + &DEBUG("evaling '$1'."); + eval $1; + } else { + &DEBUG("shm: unknown msg. ($_)"); + } + } + + &shmWrite($shm,"") if ($shmmsg ne ""); +} + 1; diff --git a/src/UserExtra.pl b/src/UserExtra.pl index 77f4480..105c22e 100644 --- a/src/UserExtra.pl +++ b/src/UserExtra.pl @@ -232,7 +232,7 @@ sub karma { sub ispell { my $query = shift; - if (! -x "/usr/bin/spell") { + if (! -x "/usr/bin/ispell") { &msg($who, "no binary found."); return; } @@ -825,6 +825,8 @@ sub userCommands { if ($param{'ircNick'} eq $ident) { &msg($who, "I hope you're right. I'll try anyway."); } + &DEBUG("ircNick => $param{'ircNick'}"); + &DEBUG("ident => $ident"); if (! &IsNickInAnyChan( $param{ircNick} ) ) { my $str = "attempting to change nick to $param{'ircNick'}"; @@ -832,8 +834,9 @@ sub userCommands { &msg($who, $str); &nick($param{'ircNick'}); } else { - &msg($who, "hrm... can't do it"); + &msg($who, "hrm.. I shouldn't do it (BUG?) but doing it anyway!"); &DEBUG("wN: nick is somewhere... should try later."); + &nick($param{'ircNick'}); } return; diff --git a/src/core.pl b/src/core.pl index 266890e..da909ce 100644 --- a/src/core.pl +++ b/src/core.pl @@ -100,10 +100,10 @@ sub doExit { &status("--- Start of quit."); $ident ||= "blootbot"; # lame hack. - &closeDCC(); + &closeDCC() if (&whatInterface() =~ /IRC/); &closePID(); &closeStats(); - &seenFlush(); + &seenFlush() if (&whatInterface() =~ /IRC/); &quit($param{'quitMsg'}) if (&whatInterface() =~ /IRC/); &writeUserFile(); &writeChanFile(); @@ -303,6 +303,27 @@ sub getChanConf { return $chanconf{"_default"}{$param}; } +sub getChanConfDefault { + my($what, $default, $chan) = @_; + + if (exists $param{$what}) { + if (!exists $cache{config}{$what}) { + &status("conf: backward-compat: found param{$what} ($param{$what}) instead."); + $cache{config}{$what} = 1; + } + + return $param{$what}; + } + my $val = &getChanConf($what, $chan); + return $val if (defined $val); + + $param{$what} = $default; + &status("conf: auto-setting param{$what} = $default"); + $cache{config}{$what} = 1; + return $default; +} + + ##### # Usage: &findChanConf($param); # About: Retrieve value for 'param' value from any chan. diff --git a/src/db_dbm.pl b/src/db_dbm.pl index caefae9..a08abe8 100644 --- a/src/db_dbm.pl +++ b/src/db_dbm.pl @@ -16,17 +16,13 @@ use vars qw(@factoids_format @rootwarn_format @seen_format); @factoids_format = ( "factoid_key", "factoid_value", - "created_by", "created_time", - "modified_by", "modified_time", - "requested_by", "requested_time", "requested_count", - "locked_by", "locked_time" ); @@ -59,16 +55,22 @@ use vars qw(@factoids_format @rootwarn_format @seen_format); "message" ); -my @dbm = ("factoids","freshmeat","rootwarn","seen"); +@stats_format = ( + "nick", + "type", + "counter" +); + +my @dbm = ("factoids","freshmeat","rootwarn","seen","stats"); sub openDB { - + use DB_File; foreach (@dbm) { next unless (&IsParam($_)); my $file = "$param{'DBName'}-$_"; - if (dbmopen(%{ $_ }, $file, 0644)) { + if (dbmopen(%{ $_ }, $file, 0666)) { &status("Opened DBM $_ ($file)."); } else { &ERROR("Failed open to DBM $_ ($file)."); @@ -92,35 +94,43 @@ sub closeDB { } ##### -# Usage: &dbGet($table, $primkey, $primval, $select); +# Usage: &dbQuote($str); +sub dbQuote { + return $_[0]; +} + +##### +# Usage: &dbGet($table, $select, $where); sub dbGet { - my ($db, $key, $val, $select) = @_; + my ($table, $select, $where) = @_; + my ($key, $val) = split('=',$where) if $where =~ /=/; my $found = 0; my @retval; my $i; - &DEBUG("dbGet($db, $key, $val, $select);"); + &DEBUG("dbGet($table, $select, $where);"); # TODO: support change that's done for db_mysql! + return unless $key; - if (!scalar @{ "${db}_format" }) { - &ERROR("dG: no valid format layout for $db."); + if (!scalar @{ "${table}_format" }) { + &ERROR("dG: no valid format layout for $table."); return; } - if (!defined ${ "$db" }{lc $val}) { # dbm hash exception. - &DEBUG("dbGet: '$val' does not exist in $db."); + if (!defined ${ "$table" }{lc $val}) { # dbm hash exception. + &DEBUG("dbGet: '$val' does not exist in $table."); return; } # return the whole row. if ($select eq "*") { - return split $;, ${ "$db" }{lc $val}; + return split $;, ${ "$table" }{lc $val}; } else { &DEBUG("dbGet: select => '$select'."); } - my @array = split "$;", ${ "$db" }{lc $val}; - for (0 .. $#{ "${db}_format" }) { - my $str = ${ "${db}_format" }[$_]; + my @array = split "$;", ${ "$table" }{lc $val}; + for (0 .. $#{ "${table}_format" }) { + my $str = ${ "${table}_format" }[$_]; next unless (grep /^$str$/, split(/\,/, $select)); $array[$_] ||= ''; @@ -139,87 +149,73 @@ sub dbGet { ##### # Usage: &dbGetCol(); +# Usage: &dbGetCol($table, $select, $where, [$type]); sub dbGetCol { - &DEBUG("STUB: &dbGetCol();"); + my ($table, $select, $where, $type) = @_; + &DEBUG("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 =~ /=/; + my (%hash) = (); + return unless ${$table}{lc $val}; + @hash{@{"${table}_format"}} = split $;, ${$table}{lc $val}; + return %hash; } ##### # Usage: &dbGetColInfo(); sub dbGetColInfo { - my ($db) = @_; + my ($table) = @_; - if (scalar @{ "${db}_format" }) { - return @{ "${db}_format" }; + if (scalar @{ "${table}_format" }) { + return @{ "${table}_format" }; } else { - &ERROR("dbGCI: invalid format name ($db) [${db}_format]."); + &ERROR("dbGCI: invalid format name ($table) [${table}_format]."); return; } } ##### -# Usage: &dbSet($db, $primkey, $primval, $key, $val); -sub dbSet { - my ($db, $primkey, $primval, $key, $val) = @_; - my $found = 0; - &DEBUG("dbSet($db, $primkey, $primval, $key, $val);"); - - my $info = ${$db}{lc $primval}; # case insensitive. - my @array = ($info) ? split(/$;/, $info) : (); - - # new entry. - if (!defined ${$db}{lc $primval}) { - # we assume primary key as first one. bad! - $array[0] = $primval; # case sensitive. - } - - for (0 .. $#{ "${db}_format" }) { - $array[$_] ||= ''; # from undefined to ''. - next unless (${ "${db}_format" }[$_] eq $key); - &DEBUG("dbSet: Setting array[$_]($key) to '$val'."); - $array[$_] = $val; - $found++; - last; - } - - if (!$found) { - &msg($who,"error: invalid element name \002$type\002."); - return 0; - } - - &DEBUG("setting $primval => '".join('|', @array)."'."); - ${$db}{lc $primval} = join $;, @array; - - return 1; -} - -sub dbUpdate { - &FIXME("STUB: &dbUpdate(@_); => somehow use dbInsert!"); -} - +# Usage: &dbInsert($table, $primkey, %hash); +# Note: dbInsert should do dbQuote. sub dbInsert { - my ($db, $primkey, %hash) = @_; + my ($table, $primkey, %hash) = @_; my $found = 0; + &DEBUG("dbInsert($table, $primkey, ...)"); - my $info = ${$db}{lc $primkey} || ''; # primkey or primval? + my $info = ${$table}{lc $primkey} || ''; # primkey or primval? - if (!scalar @{ "${db}_format" }) { - &ERROR("dbI: array ${db}_format does not exist."); + if (!scalar @{ "${table}_format" }) { + &ERROR("dbI: array ${table}_format does not exist."); return 0; } my $i; my @array = split $;, $info; - for $i (0 .. $#{ "${db}_format" }) { - $array[$i] ||= ''; - - foreach (keys %hash) { - my $col = ${ "${db}_format" }[$i]; - next unless ($col eq $_); - - &DEBUG("dbI: setting $db->$primkey\{$col} => '$hash{$_}'."); - $array[$i] = $hash{$_}; - delete $hash{$_}; - } + $array[0]=$primkey; + delete $hash{${ "${table}_format" }[0]}; + for $i (1 .. $#{ "${table}_format" }) { + my $col = ${ "${table}_format" }[$i]; + $array[$i]=$hash{$col}; + $array[$i]='' unless $array[$i]; + delete $hash{$col}; + &DEBUG("dbI: setting $table->$primkey\{$col\} => '$array[$i]'."); + +# $array[$i] ||= ''; +# foreach (keys %hash) { +# my $col = ${ "${table}_format" }[$i]; +# next unless ($col eq $_); +# next unless $hash{$_}; +# +# &DEBUG("dbI: setting $table->$primkey\{$col\} => '$hash{$_}'."); +# $array[$i] = $hash{$_}; +# delete $hash{$_}; +# } } if (scalar keys %hash) { @@ -230,61 +226,133 @@ sub dbInsert { return 0; } - ${$db}{lc $primkey} = join $;, @array; + ${$table}{lc $primkey} = join $;, @array; return 1; } +sub dbUpdate { + &FIXME("STUB: &dbUpdate(@_); => somehow use dbInsert!"); +} + ##### -# Usage: &dbSetRow($db, @values); +# Usage: &dbSetRow($table, @values); sub dbSetRow { - my ($db, @values) = @_; + my ($table, @values) = @_; + &DEBUG("dbSetRow(@_);"); my $key = lc $values[0]; - if (!scalar @{ "${db}_format" }) { - &ERROR("dbSR: array ${db}_format does not exist."); + if (!scalar @{ "${table}_format" }) { + &ERROR("dbSR: array ${table}_format does not exist."); return 0; } - if (defined ${$db}{$key}) { - &WARN("dbSetRow: $db {$key} already exists?"); + if (defined ${$table}{$key}) { + &WARN("dbSetRow: $table {$key} already exists?"); } - if (scalar @values != scalar @{ "${db}_format" }) { - &WARN("dbSetRow: scalar values != scalar ${db}_format."); + if (scalar @values != scalar @{ "${table}_format" }) { + &WARN("dbSetRow: scalar values != scalar ${table}_format."); } - for (0 .. $#{ "${db}_format" }) { + for (0 .. $#{ "${table}_format" }) { if (defined $array[$_] and $array[$_] ne "") { &DEBUG("dbSetRow: array[$_] != NULL($array[$_])."); } $array[$_] = $values[$_]; } - ${$db}{$key} = join $;, @array; - - &DEBUG("STUB: &dbSetRow(@_);"); + ${$table}{$key} = join $;, @array; } ##### -# Usage: &dbDel($db, NULL, $primval); +# Usage: &dbDel($table, $primkey, $primval, [$key]); sub dbDel { - my ($db, $primkey, $primval) = @_; + my ($table, $primkey, $primval, $key) = @_; + &DEBUG("dbDel($table, $primkey, $primval);"); - if (!scalar @{ "${db}_format" }) { - &ERROR("dbD: array ${db}_format does not exist."); + if (!scalar @{ "${table}_format" }) { + &ERROR("dbD: array ${table}_format does not exist."); return 0; } - if (!defined ${$db}{lc $primval}) { - &WARN("dbDel: lc $primval does not exist in $db."); + if (!defined ${$table}{lc $primval}) { + &WARN("dbDel: lc $primval does not exist in $table."); } else { - delete ${$db}{lc $primval}; + 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); + foreach (keys %{$href}) { + &DEBUG("dbSet: setting $_=${$href}{$_}"); + $hash{$_} = ${$href}{$_}; + } + &dbReplace($table, $key, %hash); + return 1; + + my $p = join(' AND ', map { + $_."=".&dbQuote($href->{$_}) + } keys %{$href} + ); + &WARN("dbSet not implemented yet $where $p"); return 0; + + # Usage: &dbSet($table, $primkey, $primval, $key, $val); + my ($table, $primkey, $primval, $key, $val) = @_; + my $found = 0; + &DEBUG("dbSet($table, $primkey, $primval, $key, $val);"); + + my $info = ${$table}{lc $primval}; # case insensitive. + my @array = ($info) ? split(/$;/, $info) : (); + + # new entry. + if (!defined ${$table}{lc $primval}) { + # we assume primary key as first one. bad! + $array[0] = $primval; # case sensitive. + } + + for (0 .. $#{ "${table}_format" }) { + $array[$_] ||= ''; # from undefined to ''. + next unless (${ "${table}_format" }[$_] eq $key); + &DEBUG("dbSet: Setting array[$_]($key) to '$val'."); + $array[$_] = $val; + $found++; + last; + } + + if (!$found) { + &msg($who,"error: invalid element name \002$type\002."); + return 0; + } + + &DEBUG("setting $primval => '".join('|', @array)."'."); + ${$table}{lc $primval} = join $;, @array; + + return 1; +} + sub dbRaw { &DEBUG("STUB: &dbRaw(@_);"); } @@ -312,18 +380,20 @@ sub randKey { } ##### $select is misleading??? -# Usage: &searchTable($db, $returnkey, $primkey, $str); +# Usage: &searchTable($table, $returnkey, $primkey, $str); sub searchTable { - my ($db, $primkey, $key, $str) = @_; + return; + my ($table, $primkey, $key, $str) = @_; + &DEBUG("searchTable($table, $primkey, $key, $str)"); - if (!scalar @{ "${db}_format" }) { - &ERROR("sT: no valid format layout for $db."); + if (!scalar @{ "${table}_format" }) { + &ERROR("sT: no valid format layout for $table."); return; } my @results; - foreach (keys %{$db}) { - my $val = &dbGet($db, "NULL", $_, $key) || ''; + foreach (keys %{$table}) { + my $val = &dbGet($table, "NULL", $_, $key) || ''; next unless ($val =~ /\Q$str\E/); push(@results, $_); } @@ -406,4 +476,15 @@ sub delFactoid { } } +sub checkTables { +# &openDB(); +# &closeDB(); +# foreach ("factoids", "freshmeat", "rootwarn", "seen", "stats") { +# foreach (@dbm) { +# next if (exists $table{$_}); +# &status(" creating new table $_..."); +# &dbCreateTable($_); +# } +} + 1; diff --git a/src/db_mysql.pl b/src/db_mysql.pl index 266dd69..559ac2d 100644 --- a/src/db_mysql.pl +++ b/src/db_mysql.pl @@ -465,12 +465,14 @@ sub searchTable { } $str =~ s/\_/\\_/g; - $str =~ s/\?/\_/g; # '.' should be supported, too. + $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); + &DEBUG("query => '$query'."); &SQLDebug($query); if (!$sth->execute) { &WARN("Search($query)"); diff --git a/src/interface.pl b/src/interface.pl index 70331a7..1f45c2a 100644 --- a/src/interface.pl +++ b/src/interface.pl @@ -23,13 +23,16 @@ sub cliloop { $who = "local"; $orig{who} = "local"; $ident = $param{'ircNick'}; - $talkchannel = "#CLI"; + $chan = $talkchannel = "#cli"; $addressed = 1; + $msgType = 'public'; print ">>> "; while () { $orig{message} = $_; - $_ = &process("local", 'public', $_); + $message = $_; + chomp $message; + $_ = &process() if $message; print ">>> "; } } diff --git a/src/logger.pl b/src/logger.pl index 252f72b..6227ddb 100644 --- a/src/logger.pl +++ b/src/logger.pl @@ -333,7 +333,7 @@ sub status { print "$printable\n"; } } else { - print "VERBOSITY IS OFF?\n"; + #print "VERBOSITY IS OFF?\n"; } # log the line into a file. diff --git a/src/modules.pl b/src/modules.pl index 13b878e..a3e5408 100644 --- a/src/modules.pl +++ b/src/modules.pl @@ -109,12 +109,8 @@ sub loadDBModules { } elsif ($param{'DBType'} =~ /^dbm$/i) { - &status(" using Berkeley DBM 1.85/2.0 support."); - &ERROR("dbm support is broken... if you want it, fix it yourself!"); - &shutdown(); - exit 1; - -# require "$bot_src_dir/db_dbm.pl"; + &status(" using Berkeley DBM support."); + require "$bot_src_dir/db_dbm.pl"; } else { &status("DB support DISABLED."); @@ -145,7 +141,8 @@ sub loadFactoidsModules { } sub loadIRCModules { - if (&whatInterface() =~ /IRC/) { + my ($interface) = &whatInterface(); + if ($interface =~ /IRC/) { &status("Loading IRC modules..."); eval "use Net::IRC"; @@ -154,18 +151,20 @@ sub loadIRCModules { exit 1; } &showProc(" (Net::IRC)"); - } else { &status("IRC support DISABLED."); - return; + # disabling forking. + $param{forking} = 0; + $param{noSHM} = 1; } - foreach ( &getPerlFiles("$bot_src_dir/IRC") ) { - my $mod = "$bot_src_dir/IRC/$_"; + foreach ( &getPerlFiles("$bot_src_dir/$interface") ) { + my $mod = "$bot_src_dir/$interface/$_"; + &status("Loading Modules \"$mod\""); eval "require \"$mod\""; if ($@) { - &ERROR("lIRCM => $@"); + &ERROR("require \"$mod\" => $@"); &shutdown(); exit 1; } -- 2.39.2