- use &hasParam() instead of IsChanConf for more commands

- very minor changes not worth mentioning individually
- regex typo in hookMode()
- disable chanLimitVerify on on_join()
- debugging added to netsplit code

git-svn-id: https://svn.code.sf.net/p/infobot/code/trunk/blootbot@479 c11ca15a-4712-0410-83d8-924469b57eb5

diff --git a/src/CommandStubs.pl b/src/CommandStubs.pl
index e4380702bbe1e4ed97978aaf2f082478303ade64..7b2ca5d37f198d9c6a29668a16000596ce0bb5b4 100644 (file)
--- a/src/CommandStubs.pl
+++ b/src/CommandStubs.pl
@@ -223,7 +223,7 @@ sub Modules {
     }
 
     # babel bot: Jonathan Feinberg++
-    if (&IsChanConf("babelfish") and $message =~ m{
+    if ($message =~ m{
                ^\s*
                (?:babel(?:fish)?|x|xlate|translate)
                \s+
@@ -232,7 +232,8 @@ sub Modules {
                ($babel_lang_regex)\w*  # which language?
                \s*
                (.+)                    # The phrase to be translated
-       }xoi) {
+    }xoi) {
+       return unless (&hasParam("babelfish"));
 
        &Forker("babelfish", sub { &babel::babelfish(lc $1, lc $2, $3); } );
 
@@ -240,24 +241,24 @@ sub Modules {
        return;
     }
 
-    if (&IsChanConf("debian")) {
-       my $debiancmd    = 'conflicts?|depends?|desc|file|info|provides?';
-       $debiancmd      .= '|recommends?|suggests?|maint|maintainer';
-       if ($message =~ /^($debiancmd)(\s+(.*))?$/i) {
-           my $package = lc $3;
+    my $debiancmd       = 'conflicts?|depends?|desc|file|info|provides?';
+    $debiancmd         .= '|recommends?|suggests?|maint|maintainer';
 
-           if (defined $package) {
-               &Forker("debian", sub { &Debian::infoPackages($1, $package); } );
-           } else {
-               &help($1);
-           }
+    if ($message =~ /^($debiancmd)(\s+(.*))?$/i) {
+       return unless (&hasParam("debian"));
+       my $package = lc $3;
 
-           return;
+       if (defined $package) {
+           &Forker("debian", sub { &Debian::infoPackages($1, $package); } );
+       } else {
+           &help($1);
        }
+
+       return;
     }
 
     # google searching. Simon++
-    if (&IsChanConf("wwwsearch") and $message =~ /^(?:search\s+)?(\S+)\s+for\s+['"]?(.*?)['"]?\s*\?*$/i) {
+    if ($message =~ /^(?:search\s+)?(\S+)\s+for\s+['"]?(.*?)['"]?\s*\?*$/i) {
        return unless (&hasParam("wwwsearch"));
 
        &Forker("wwwsearch", sub { &W3Search::W3Search($1,$2); } );
@@ -478,7 +479,7 @@ sub seen {
 
     &seenFlush();      # very evil hack. oh well, better safe than sorry.
 
-    ### TODO: Support &dbGetRowInfo(); like in &FactInfo();
+    ### TODO: Support &dbGetColInfo(); like in &FactInfo();
     my $select = "nick,time,channel,host,message";
     if ($person eq "random") {
        @seen = &randKey("seen", $select);

diff --git a/src/Factoids/Question.pl b/src/Factoids/Question.pl
index 51686a8a47ba75557ba1fb40584eea72b594449b..3e689ab5bc86f40ee347e83199b1f1671ff0e2ae 100644 (file)
--- a/src/Factoids/Question.pl
+++ b/src/Factoids/Question.pl
@@ -19,14 +19,13 @@ use vars qw(%bots %forked);
 sub doQuestion {
     # my doesn't allow variables to be inherinted, local does.
     # following is used in math()...
-    local($query) = @_;
-    local($reply) = "";
-    local $finalQMark = $query =~ s/\?+\s*$//;
-    $finalQMark += $query =~ s/\?\s*$//;
-    $query =~ s/^\s+|\s+$//g;
+    local($query)      = @_;
+    local($reply)      = "";
+    local $finalQMark  = $query =~ s/\?+\s*$//;
+    $finalQMark                += $query =~ s/\?\s*$//;
+    $query             =~ s/^\s+|\s+$//g;
 
     if (!defined $query or $query =~ /^\s*$/) {
-       &FIXME("doQ: query == NULL (message => $message)");
        return '';
     }
 

diff --git a/src/Factoids/Update.pl b/src/Factoids/Update.pl
index 827e9cd25d91b6858fd0d5e5cfe52751eac2b80c..79abd84c1d9a3e2c0b70f0050dac60338d6e3951 100644 (file)
--- a/src/Factoids/Update.pl
+++ b/src/Factoids/Update.pl
@@ -49,8 +49,7 @@ sub update {
     }
 
     # also checking.
-    my $also    = ($rhs =~ s/^(\-)?also //i);
-    &DEBUG("1=>$1");   # this does not work!
+    my $also    = ($rhs =~ s/^-?also //i);
     my $also_or = ($also and $rhs =~ s/\s+(or|\|\|)\s+//);
 
     # freshmeat
@@ -68,7 +67,7 @@ sub update {
     if (!$exists) {
        # nice 'are' hack (or work-around).
        if ($mhs =~ /^are$/i and $rhs !~ /<\S+>/) {
-           &DEBUG("Update: 'are' hack detected.");
+           &status("Update: 'are' hack detected.");
            $mhs = "is";
            $rhs = "<REPLY> are ". $rhs;
        }
@@ -106,12 +105,16 @@ sub update {
 #          if ($exists =~ s/\,\s*$/,  /) {
            if ($exists =~ /\,\s*$/) {
                &DEBUG("current has trailing comma, just append as is");
+               &DEBUG("Up: exists => $exists");
+               &DEBUG("Up: rhs    => $rhs");
                # $rhs =~ s/^\s+//;
                # $rhs = $exists." ".$rhs;      # keep comma.
            }
 
            if ($exists =~ /\.\s*$/) {
                &DEBUG("current has trailing period, just append as is with 2 WS");
+               &DEBUG("Up: exists => $exists");
+               &DEBUG("Up: rhs    => $rhs");
                # $rhs =~ s/^\s+//;
                # use ucfirst();?
                # $rhs = $exists."  ".$rhs;     # keep comma.

diff --git a/src/IRC/Irc.pl b/src/IRC/Irc.pl
index 5d03222be91ce6c1947a362f37aa3699eeb45859..3acce09ceb3a1cf45f40595a84e9876ad389a756 100644 (file)
--- a/src/IRC/Irc.pl
+++ b/src/IRC/Irc.pl
@@ -622,10 +622,9 @@ sub joinNextChan {
     }
 
     # !scalar @joinchan:
-
     if (exists $cache{joinTime}) {
        my $delta       = time() - $cache{joinTime};
-       my $timestr = &Time2String($delta);
+       my $timestr     = &Time2String($delta);
        my $rate        = sprintf("%.1f", $delta / &getJoinChans() );
        delete $cache{joinTime};
 

diff --git a/src/IRC/IrcHelpers.pl b/src/IRC/IrcHelpers.pl
index 021350be63286c6aa0ac89fbb1b9f57df3fbcfc2..e0acbcf5584a12e94a66c02d20e36c416ec8b88b 100644 (file)
--- a/src/IRC/IrcHelpers.pl
+++ b/src/IRC/IrcHelpers.pl
@@ -45,7 +45,7 @@ sub hookMode {
 
            # modes w/ target affecting nick => cache it.
            if ($mode =~ /[bov]/) {
-               if ($mode eq "o" and $nick eq "ChanServ" and $target =~ /^\Q$ident$\E/i) {
+               if ($mode eq "o" and $nick eq "ChanServ" and $target =~ /^\Q$ident\E$/i) {
                    &DEBUG("hookmode: chanserv deopped us! asking");
                    &chanServCheck($chan);
                }

diff --git a/src/IRC/IrcHooks.pl b/src/IRC/IrcHooks.pl
index 561eebb5c7e30cee56b5dda4cc8c9c0c61ba72a2..d1359d901d3cbef6642b56aff504d09273c517a8 100644 (file)
--- a/src/IRC/IrcHooks.pl
+++ b/src/IRC/IrcHooks.pl
@@ -516,7 +516,7 @@ sub on_join {
     }
 
     ### chanlimit check.
-    &chanLimitVerify($chan);
+#    &chanLimitVerify($chan);
 
     ### wingate:
     &wingateCheck();
@@ -829,7 +829,7 @@ sub on_quit {
 
        # chanlimit code.
        if (&ChanConfList("chanlimitcheck") and !scalar keys %netsplit) {
-           &DEBUG("on_quit: netsplit detected; disabling chan limit.");
+           &DEBUG("on_quit: netsplit detected on $chan; disabling chan limit.");
            &rawout("MODE $chan -l");
        }
 

diff --git a/src/IRC/Schedulers.pl b/src/IRC/Schedulers.pl
index 4bc1ae07a9aaa858a407de51236f989ceaf4cfc4..4566df6872f2047dba1554a33480900108d3858f 100644 (file)
--- a/src/IRC/Schedulers.pl
+++ b/src/IRC/Schedulers.pl
@@ -419,8 +419,15 @@ sub netsplitCheck {
        return if ($_[0] eq "2");
     }
 
+    &DEBUG("running netsplitCheck...");
+
     foreach $s1 (keys %netsplitservers) {
+       &DEBUG("nsC: s1 => $s1");
+
        foreach $s2 (keys %{ $netsplitservers{$s1} }) {
+           my $delta = time() - $netsplitservers{$s1}{$s2};
+           &DEBUG("nss{$s1}{$s2} = $delta");
+
            if (time() - $netsplitservers{$s1}{$s2} > 3600) {
                &status("netsplit between $s1 and $s2 appears to be stale.");
                delete $netsplitservers{$s1}{$s2};
@@ -496,7 +503,7 @@ sub seenFlush {
     if ($param{'DBType'} =~ /^mysql|pg|postgres/i) {
        foreach $nick (keys %seencache) {
            my $retval = &dbReplace("seen", "nick", $nick, (
-                       "nick" => $seencache{$nick}{'nick'},
+###                    "nick" => $seencache{$nick}{'nick'},
                        "time" => $seencache{$nick}{'time'},
                        "host" => $seencache{$nick}{'host'},
                        "channel" => $seencache{$nick}{'chan'},
@@ -785,8 +792,6 @@ sub miscCheck2 {
        return if ($_[0] eq "2");       # defer.
     }
 
-    &DEBUG("miscCheck2: Doing debian checking...");
-
     # debian check.
     opendir(DEBIAN, "$bot_base_dir/debian");
     foreach ( grep /gz$/, readdir(DEBIAN) ) {

diff --git a/src/Modules/Debian.pl b/src/Modules/Debian.pl
index e191496f223addc0d83b4361d1a18cf2af09c6f5..331493e5462302b7781b34f2d1545f9c7c58e891 100644 (file)
--- a/src/Modules/Debian.pl
+++ b/src/Modules/Debian.pl
@@ -14,6 +14,7 @@ my $announce  = 0;
 my $defaultdist        = "sid";
 my $refresh = &::getChanConfDefault("debianRefreshInterval",7)
                        * 60 * 60 * 24;
+my $debug      = 1;
 
 ### ... old
 #my %dists     = (
@@ -96,7 +97,7 @@ sub DebianDownload {
 
        next unless ($update);
 
-       &::DEBUG("announce == $announce.");
+       &::DEBUG("announce == $announce.") if ($debug);
        if ($good + $bad == 0 and !$announce) {
            &::status("Debian: Downloading files for '$dist'.");
            &::msg($::who, "Updating debian files... please wait.");
@@ -104,9 +105,9 @@ sub DebianDownload {
        }
 
        if (exists $::debian{$url}) {
-           &::DEBUG("2: ".(time - $::debian{$url})." <= $refresh");
+           &::DEBUG("2: ".(time - $::debian{$url})." <= $refresh") if ($debug);
            next if (time() - $::debian{$url} <= $refresh);
-           &::DEBUG("stale for url $url; updating!");
+           &::DEBUG("stale for url $url; updating!") if ($debug);
        }
 
        if ($url =~ /^ftp:\/\/(.*?)\/(\S+)\/(\S+)$/) {
@@ -127,7 +128,7 @@ sub DebianDownload {
            }
 
            if (! -f $file) {
-               &::DEBUG("deb: down: ftpGet: !file");
+               &::WARN("deb: down: ftpGet: !file");
                $bad++;
                next;
            }
@@ -138,7 +139,7 @@ sub DebianDownload {
 #              system("cp debian/Contents-potato-i386-non-US.gz debian/Contents-woody-i386-non-US.gz");
 #          }
 
-           &::DEBUG("deb: download: good.");
+           &::DEBUG("deb: download: good.") if ($debug);
            $good++;
        } else {
            &::ERROR("Debian: invalid format of url => ($url).");
@@ -302,20 +303,17 @@ sub searchContents {
        $pkg =~ s/\,/\037\,\037/g;      # underline ','.
        push(@list, "(". join(', ',@sublist) .") in $pkg");
     }
-    &::DEBUG("debian: 0");
     # sort the total list from shortest to longest...
     @list = sort { length $a <=> length $b } @list;
 
     # show how long it took.
-    &::DEBUG("debian: 1");
     my $delta_time = &::timedelta($start_time);
-    &::DEBUG("debian: 2");
     &::status(sprintf("Debian: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0);
-    &::DEBUG("debian: 3");
 
     my $prefix = "Debian Search of '$query' ";
     if (scalar @list) {        # @list.
        &::pSReply( &::formListReply(0, $prefix, @list) );
+
     } else {           # !@list.
        &::DEBUG("ok, !\@list, searching desc for '$query'.");
        my @list = &searchDesc($query);
@@ -323,9 +321,11 @@ sub searchContents {
        if (!scalar @list) {
            my $prefix = "Debian Package/File/Desc Search of '$query' ";
            &::pSReply( &::formListReply(0, $prefix, ) );
+
        } elsif (scalar @list == 1) {   # list = 1.
            &::DEBUG("list == 1; showing package info of '$list[0]'.");
            &infoPackages("info", $list[0]);
+
        } else {                                # list > 1.
            my $prefix = "Debian Desc Search of '$query' ";
            &::pSReply( &::formListReply(0, $prefix, @list) );
@@ -365,6 +365,7 @@ sub searchAuthor {
     if ($good == 0 and $bad != 0) {
        my %urls = &fixDist($dist, %urlpackages);
        &::DEBUG("deb: download 2.");
+
        if (!&DebianDownload($dist, %urls)) {
            &::ERROR("Debian(sA): could not download files.");
            return;
@@ -376,6 +377,7 @@ sub searchAuthor {
     while (<IN>) {
        if (/^Package: (\S+)$/) {
            $package = $1;
+
        } elsif (/^Maintainer: (.*) \<(\S+)\>$/) {
            my($name,$email) = ($1,$2);
            if ($package eq "") {
@@ -385,6 +387,7 @@ sub searchAuthor {
            $maint{$name}{$email} = 1;
            $pkg{$name}{$package} = 1;
            $package = "";
+
        } else {
            &::WARN("invalid line: '$_'.");
        }
@@ -400,8 +403,10 @@ sub searchAuthor {
     # TODO: should we only search email if '@' is used?
     if (scalar keys %hash < 15) {
        my $name;
+
        foreach $name (keys %maint) {
            my $email;
+
            foreach $email (keys %{ $maint{$name} }) {
                next unless ($email =~ /\Q$query\E/i);
                next if (exists $hash{$name});
@@ -462,6 +467,7 @@ sub searchDesc {
     if ($good == 0 and $bad != 0) {
        my %urls = &fixDist($dist, %urlpackages);
        &::DEBUG("deb: download 2c.");
+
        if (!&DebianDownload($dist, %urls)) {
            &::ERROR("Debian(sD): could not download files.");
            return;
@@ -647,7 +653,8 @@ sub infoPackages {
     # hrm...
     my %urls = &fixDist($dist, %urlpackages);
     if ($dist ne "incoming") {
-       &::DEBUG("deb: download 3.");
+       &::DEBUG("deb: download 3.") if ($debug);
+
        if (!&DebianDownload($dist, %urls)) {   # no good download.
            &::WARN("Debian(iP): could not download ANY files.");
        }
@@ -911,7 +918,7 @@ sub validPackage {
     my $olddist        = $dist;
     $dist = &getDistro($dist);
 
-    &::DEBUG("D: validPackage($package, $dist) called.");
+    &::DEBUG("D: validPackage($package, $dist) called.") if ($debug);
 
     my $error = 0;
     while (!open(IN, "debian/Packages-$dist.idx")) {

diff --git a/src/Modules/Factoids.pl b/src/Modules/Factoids.pl
index b2e36461bf329ca395293f74bdd649f02f04961f..5fda311250c0e82ac152189eb837f0fcd114b8d6 100644 (file)
--- a/src/Modules/Factoids.pl
+++ b/src/Modules/Factoids.pl
@@ -22,7 +22,7 @@ sub CmdFactInfo {
     my $i = 0;
     my %factinfo;
     my @factinfo = &getFactInfo($faqtoid,"*");
-    foreach ( &dbGetRowInfo("factoids") ) {
+    foreach ( &dbGetColInfo("factoids") ) {
        $factinfo{$_} = $factinfo[$i] || '';
        $i++;
     }

diff --git a/src/Modules/News.pl b/src/Modules/News.pl
index 6c2696a1d1ce9c613cf67a9aa021f2790bd36220..b7cada9b84d2adb37f74f4369b70bf877cb54302 100644 (file)
--- a/src/Modules/News.pl
+++ b/src/Modules/News.pl
@@ -80,7 +80,7 @@ sub Parse {
        &set($2);
 
     } elsif ($what =~ /^(\d+)$/i) {
-       &::DEBUG("read shortcut called.");
+       &::VERB("News: read shortcut called.",2);
        &read($1);
 
     } elsif ($what =~ /^read(\s+(.*))?$/i) {
@@ -707,8 +707,6 @@ sub latest {
            if (time() - $::news{$chan}{$_}{Time} > 60*60*24*3) {
                &::DEBUG("deleting news{$chan}{$_} because it was too old and had no text info.");
                delete $::news{$chan}{$_};
-           } else {
-               &::WARN("news: news{$chan}{$_}{Text} undef.");
            }
 
            next;
@@ -729,7 +727,7 @@ sub latest {
     if (!$flag) {
        return unless ($unread);
 
-       my $reply = "There are unread news in $chan ($unread unread, $total total). /msg $::ident news latest.";
+       my $reply = "There are unread news in $chan ($unread unread, $total total). /msg $::ident news latest";
        $reply   .= "  If you don't want further news notification, /msg $::ident news unnotify" if ($unread == $total);
        &::notice($::who, $reply);
 

diff --git a/src/Shm.pl b/src/Shm.pl
index b9756bce3676b6e42d0e778fb9b1dddd73e60491..4d34170a391dd31bb35cef504990a7bb7e8b780e 100644 (file)
--- a/src/Shm.pl
+++ b/src/Shm.pl
@@ -129,10 +129,12 @@ sub addForked {
        $continue++ if ($forked{$name}{PID} == $$);
 
        if ($continue) {
-           &DEBUG("hrm.. fork pid == mypid == $$; how did this happen?");
+           &WARN("hrm.. fork pid == mypid == $$; how did this happen?");
+
        } elsif ( -d "/proc/$forked{$name}{PID}") {
            &status("fork: still running; good. BAIL OUT.");
            return 0;
+
        } else {
            &WARN("Found dead fork; removing and resetting.");
            $continue = 1;
@@ -140,8 +142,10 @@ sub addForked {
 
        if ($continue) {
            # NOTHING.
+
        } elsif (time() - $time > 900) {        # stale fork > 15m.
            &status("forked: forked{$name} presumably exited without notifying us.");
+
        } else {                                # fresh fork.
            &msg($who, "$name is already running ". &Time2String(time() - $time));
            return 0;

diff --git a/src/UserExtra.pl b/src/UserExtra.pl
index 184a3f03a53adb39c213fbdebe81d682f7c84b2d..db1af0a25ec93b793a3061335c7ff84ea4b38a5d 100644 (file)
--- a/src/UserExtra.pl
+++ b/src/UserExtra.pl
@@ -352,7 +352,7 @@ sub tell {
        $message        = $tell_obj;
        $done++ unless (&Modules());
 
-       &DEBUG("setting old values of who and msgType.");
+       &VERB("teel: setting old values of who and msgType.",2);
        $who            = $oldwho;
        $msgType        = $oldmtype;
 

diff --git a/src/db_dbm.pl b/src/db_dbm.pl
index 219fb472521075033f31d94f619df12cf95ed5bc..ece2927e58e982e560019c212585b989c4875fbe 100644 (file)
--- a/src/db_dbm.pl
+++ b/src/db_dbm.pl
@@ -143,8 +143,8 @@ sub dbGetCol {
 }
 
 #####
-# Usage: &dbGetRowInfo();
-sub dbGetRowInfo {
+# Usage: &dbGetColInfo();
+sub dbGetColInfo {
     my ($db) = @_;
 
     if (scalar @{ "${db}_format" }) {