From 64b1ab9e23f7895f1ab62a8168d77955a11451fc Mon Sep 17 00:00:00 2001 From: dms Date: Tue, 8 May 2001 12:39:17 +0000 Subject: [PATCH] - 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 --- src/CommandStubs.pl | 31 ++++++++++++++++--------------- src/Factoids/Question.pl | 11 +++++------ src/Factoids/Update.pl | 9 ++++++--- src/IRC/Irc.pl | 3 +-- src/IRC/IrcHelpers.pl | 2 +- src/IRC/IrcHooks.pl | 4 ++-- src/IRC/Schedulers.pl | 11 ++++++++--- src/Modules/Debian.pl | 29 ++++++++++++++++++----------- src/Modules/Factoids.pl | 2 +- src/Modules/News.pl | 6 ++---- src/Shm.pl | 6 +++++- src/UserExtra.pl | 2 +- src/db_dbm.pl | 4 ++-- 13 files changed, 68 insertions(+), 52 deletions(-) diff --git a/src/CommandStubs.pl b/src/CommandStubs.pl index e438070..7b2ca5d 100644 --- 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 51686a8..3e689ab 100644 --- 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 827e9cd..79abd84 100644 --- 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 = " 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 5d03222..3acce09 100644 --- 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 021350b..e0acbcf 100644 --- 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 561eebb..d1359d9 100644 --- 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 4bc1ae0..4566df6 100644 --- 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 e191496..331493e 100644 --- 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 () { 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 b2e3646..5fda311 100644 --- 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 6c2696a..b7cada9 100644 --- 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 b9756bc..4d34170 100644 --- 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 184a3f0..db1af0a 100644 --- 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 219fb47..ece2927 100644 --- 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" }) { -- 2.39.2