From 0e3df27228cf790fad3c3d9b6496db63c3ece37e Mon Sep 17 00:00:00 2001 From: dms Date: Fri, 20 Apr 2001 12:54:49 +0000 Subject: [PATCH] converted %{$blah{$blah}} to %{ $blah{$blah} } added IRC hooks to catch failed channel joins chanserv function moved to joinNextChan created chanserv function for "common" use, chanServCheck changed cache{chanlimitChange} hash a little chanserv check removed from on_endofnames typo on on_invite - fixed. chanserv/ops removed from ircCheck() joinNextChan removed from ircCheck() added preliminary debian BTS frontend support git-svn-id: https://svn.code.sf.net/p/infobot/code/trunk/blootbot@453 c11ca15a-4712-0410-83d8-924469b57eb5 --- src/CommandStubs.pl | 15 +++++---- src/DynaConfig.pl | 2 +- src/Factoids/Question.pl | 2 +- src/Factoids/Reply.pl | 4 +-- src/Factoids/Statement.pl | 2 +- src/IRC/Irc.pl | 47 +++++++++++++------------- src/IRC/IrcHelpers.pl | 42 +++++++++++++++++++---- src/IRC/IrcHooks.pl | 69 ++++++++++++++++++++++++++++---------- src/IRC/Schedulers.pl | 33 ++++++------------ src/Misc.pl | 2 +- src/Modules/Debian.pl | 14 ++++---- src/Modules/DebianExtra.pl | 69 ++++++++++++++++++++++++++++++++++++-- src/Modules/Factoids.pl | 14 ++++---- src/Modules/Topic.pl | 12 +++---- src/Modules/Units.pl | 2 +- src/Modules/Uptime.pl | 2 +- src/Modules/UserDCC.pl | 4 +-- src/Process.pl | 13 +++---- src/UserExtra.pl | 18 +++++----- 19 files changed, 242 insertions(+), 124 deletions(-) diff --git a/src/CommandStubs.pl b/src/CommandStubs.pl index 3b732d6..c31129e 100644 --- a/src/CommandStubs.pl +++ b/src/CommandStubs.pl @@ -1,5 +1,6 @@ # # User Command Extension Stubs +# WARN: this file does not reload on HUP. # if (&IsParam("useStrict")) { use strict; } @@ -102,9 +103,9 @@ sub parseCmdHook { $hash{'Identifier'} .= "-" if ($hash{'Forker'} eq "NULL"); if (exists $hash{'ArrayArgs'}) { - &Forker($hash{'Identifier'}, sub { \&{$hash{'CODEREF'}}(@args) } ); + &Forker($hash{'Identifier'}, sub { \&{ $hash{'CODEREF'} }(@args) } ); } else { - &Forker($hash{'Identifier'}, sub { \&{$hash{'CODEREF'}}($flatarg) } ); + &Forker($hash{'Identifier'}, sub { \&{ $hash{'CODEREF'} }($flatarg) } ); } } else { @@ -123,9 +124,9 @@ sub parseCmdHook { } if (exists $hash{'ArrayArgs'}) { - &{$hash{'CODEREF'}}(@args); + &{ $hash{'CODEREF'} }(@args); } else { - &{$hash{'CODEREF'}}($flatarg); + &{ $hash{'CODEREF'} }($flatarg); } } @@ -146,7 +147,7 @@ sub parseCmdHook { ### ### START ADDING HOOKS. ### -&addCmdHook("extra", 'd?bugs', ('CODEREF' => 'debianBugs', +&addCmdHook("extra", 'd?bugs', ('CODEREF' => 'DBugs::Parse', 'Forker' => 1, 'Identifier' => 'debianExtra', 'Cmdstats' => 'Debian Bugs') ); &addCmdHook("extra", 'dauthor', ('CODEREF' => 'Debian::searchAuthor', @@ -331,7 +332,7 @@ sub Modules { ### TODO: compact with map? my @list; foreach (sort {$b <=> $a} keys %nickometer) { - my $str = join(", ", sort keys %{$nickometer{$_}}); + my $str = join(", ", sort keys %{ $nickometer{$_} }); push(@list, "$str ($_%)"); } @@ -556,7 +557,7 @@ sub cookie { # lets find that secret cookie. my $target = ($msgType ne 'public') ? $who : $talkchannel; - my $cookiemsg = &getRandom(keys %{$lang{'cookie'}}); + my $cookiemsg = &getRandom(keys %{ $lang{'cookie'} }); my ($key,$value); ### WILL CHEW TONS OF MEM. diff --git a/src/DynaConfig.pl b/src/DynaConfig.pl index 926daf4..e23edf0 100644 --- a/src/DynaConfig.pl +++ b/src/DynaConfig.pl @@ -417,7 +417,7 @@ sub verifyUser { foreach $user (keys %users) { next if ($user eq "_default"); - foreach $m (keys %{$users{$user}{HOSTS}}) { + foreach $m (keys %{ $users{$user}{HOSTS} }) { $m =~ s/\?/./g; $m =~ s/\*/.*?/g; $m =~ s/([\@\(\)\[\]])/\\$1/g; diff --git a/src/Factoids/Question.pl b/src/Factoids/Question.pl index a356f82..f838b92 100644 --- a/src/Factoids/Question.pl +++ b/src/Factoids/Question.pl @@ -69,7 +69,7 @@ sub doQuestion { $query =~ s/^explain\s*(\?*)/$1/i; # explain x $query = " $query "; # side whitespaces. - my $qregex = join '|', keys %{$lang{'qWord'}}; + my $qregex = join '|', keys %{ $lang{'qWord'} }; # what's whats => what is; who'?s => who is, etc $query =~ s/ ($qregex)\'?s / $1 is /i; diff --git a/src/Factoids/Reply.pl b/src/Factoids/Reply.pl index 5e219f4..1c470c4 100644 --- a/src/Factoids/Reply.pl +++ b/src/Factoids/Reply.pl @@ -139,7 +139,7 @@ sub getReply { # result is random if separated by '||'. # rhs is full factoid with '||'. if ($mhs eq "is") { - $reply = &getRandom(keys %{$lang{'factoid'}}); + $reply = &getRandom(keys %{ $lang{'factoid'} }); $reply =~ s/##KEY/$lhs/; $reply =~ s/##VALUE/$result/; } else { @@ -200,7 +200,7 @@ sub getReply { $reply =~ s/\$randpercentage/$randp/g; # ??? # randnick. if ($reply =~ /\$randnick/) { - my @nicks = keys %{$channels{$chan}{''}}; + my @nicks = keys %{ $channels{$chan}{''} }; my $randnick = $nicks[ int($rand*$#nicks) ]; s/\$randnick/$randnick/; } diff --git a/src/Factoids/Statement.pl b/src/Factoids/Statement.pl index 6c05f93..ed58a44 100644 --- a/src/Factoids/Statement.pl +++ b/src/Factoids/Statement.pl @@ -72,7 +72,7 @@ sub doStatement { if (&validFactoid($lhs,$rhs) == 0) { if ($addressed) { &status("IGNORE statement: <$who> $message"); - &performReply( &getRandom(keys %{$lang{'confused'}}) ); + &performReply( &getRandom(keys %{ $lang{'confused'} }) ); } return; } diff --git a/src/IRC/Irc.pl b/src/IRC/Irc.pl index 9334f98..c3e5ee3 100644 --- a/src/IRC/Irc.pl +++ b/src/IRC/Irc.pl @@ -144,6 +144,11 @@ sub irc { $conn->add_global_handler(376, \&on_endofmotd); # on_connect. $conn->add_global_handler(433, \&on_nick_taken); $conn->add_global_handler(439, \&on_targettoofast); + # for proper joinnextChan behaviour + $conn->add_global_handler(471, \&on_chanfull); + $conn->add_global_handler(473, \&on_inviteonly); + $conn->add_global_handler(474, \&on_banned); + $conn->add_global_handler(475, \&on_badchankey); # end of handler stuff. @@ -300,7 +305,7 @@ sub DCCBroadcast { ### FIXME: flag not supported yet. - foreach (keys %{$dcc{'CHAT'}}) { + foreach (keys %{ $dcc{'CHAT'} }) { $conn->privmsg($dcc{'CHAT'}{$_}, $txt); } } @@ -385,7 +390,7 @@ sub dcc_close { foreach $type (keys %dcc) { &FIXME("dcc_close: $who"); - my @who = grep /^\Q$who\E$/i, keys %{$dcc{$type}}; + my @who = grep /^\Q$who\E$/i, keys %{ $dcc{$type} }; next unless (scalar @who); $who = $who[0]; } @@ -564,28 +569,24 @@ sub invite { # Usage: &joinNextChan(); sub joinNextChan { + &DEBUG("joinNextChan called."); + if (scalar @joinchan) { - my $chan = shift @joinchan; + $chan = shift @joinchan; &joinchan($chan); if (my $i = scalar @joinchan) { &status("joinNextChan: $i chans to join."); } - return; - } - if (&IsParam("nickServ_pass") and $nickserv < 1) { - &WARN("jNC: nickserv/chanserv not up.") if (!$nickserv); - $nickserv--; - } + # chanserv check: channel specific. + &chanServCheck($chan); + + } else { + # chanserv check: global channels, in case we missed one. - my %chan = &getChanConfList("chanServ"); - foreach $chan (keys %chan) { - next unless ($chan{$chan} > 0); - - if (!exists $channels{$chan}{'o'}{$ident}) { - &status("ChanServ ==> Requesting ops for $chan. (1)"); - &rawout("PRIVMSG ChanServ :OP $chan $ident"); + foreach ( &ChanConfList("chanServ_ops") ) { + &chanServCheck($_); } } } @@ -596,7 +597,7 @@ sub GetNickInChans { my @array; foreach (keys %channels) { - next unless (grep /^\Q$nick\E$/i, keys %{$channels{$_}{''}}); + next unless (grep /^\Q$nick\E$/i, keys %{ $channels{$_}{''} }); push(@array, $_); } @@ -621,7 +622,7 @@ sub IsNickInChan { return 0; } - if (grep /^\Q$nick\E$/i, keys %{$channels{$chan}{''}}) { + if (grep /^\Q$nick\E$/i, keys %{ $channels{$chan}{''} }) { return 1; } else { foreach (keys %channels) { @@ -636,7 +637,7 @@ sub IsNickInAnyChan { my ($nick) = @_; foreach $chan (keys %channels) { - next unless (grep /^\Q$nick\E$/i, keys %{$channels{$chan}{''}}); + next unless (grep /^\Q$nick\E$/i, keys %{ $channels{$chan}{''} }); return 1; } return 0; @@ -665,7 +666,7 @@ sub DeleteUserInfo { my ($mode,$chan); foreach $chan (@chans) { - foreach $mode (keys %{$channels{$chan}}) { + foreach $mode (keys %{ $channels{$chan} }) { # use grep here? next unless (exists $channels{$chan}{$mode}{$nick}); @@ -727,7 +728,7 @@ sub closeDCC { foreach $type (keys %dcc) { next if ($type ne uc($type)); - foreach $nick (keys %{$dcc{$type}}) { + foreach $nick (keys %{ $dcc{$type} }) { next unless (defined $nick); &DEBUG("closing DCC $type to $nick (FIXME)."); next unless (defined $dcc{$type}{$nick}); @@ -746,7 +747,7 @@ sub joinfloodCheck { return unless (&IsChanConf("joinfloodCheck")); if (exists $netsplit{lc $who}) { # netsplit join. - &DEBUG("jfC: $who was in netsplit; not checking."); + &DEBUG("joinfloodCheck: $who was in netsplit; not checking."); } if (exists $floodjoin{$chan}{$who}{Time}) { @@ -784,7 +785,7 @@ sub joinfloodCheck { } } - &DEBUG("jfC: $delete deleted.") if ($delete); + &DEBUG("joinfloodCheck: $delete deleted.") if ($delete); } sub getHostMask { diff --git a/src/IRC/IrcHelpers.pl b/src/IRC/IrcHelpers.pl index 56811b7..cbacea0 100644 --- a/src/IRC/IrcHelpers.pl +++ b/src/IRC/IrcHelpers.pl @@ -177,12 +177,12 @@ sub hookMsg { # flood overflow protection. if ($addressed) { - foreach (keys %{$flood{$floodwho}}) { + foreach (keys %{ $flood{$floodwho} }) { next unless (time() - $flood{$floodwho}{$_} > $interval); delete $flood{$floodwho}{$_}; } - my $i = scalar keys %{$flood{$floodwho}}; + my $i = scalar keys %{ $flood{$floodwho} }; if ($i > $count) { &msg($who,"overflow of messages ($i > $count)"); &status("FLOOD overflow detected from $floodwho; ignoring"); @@ -267,21 +267,49 @@ sub chanLimitVerify { &WARN("clc: stupid to have plus at $plus, fix it!"); } - if (exists $cache{ "chanlimitChange_$chan" }) { - if (time() - $cache{ "chanlimitChange_$chan" } < $int*60) { + if (exists $cache{chanlimitChange}{$chan}) { + if (time() - $cache{chanlimitChange}{$chan} < $int*60) { return; } } - ### todo: check if we have ops. - ### todo: if not, check if nickserv/chanserv is avail. + &chanServCheck($chan); + ### todo: unify code with chanlimitcheck() if ($delta > 5) { &status("clc: big change in limit; changing."); &rawout("MODE $chan +l ".($count+$plus) ); - $cache{ "chanlimitChange_$chan" } = time(); + $cache{chanlimitChange}{$chan} = time(); } } } +sub chanServCheck { + ($chan) = @_; + + if (!defined $chan or $chan =~ /^$/) { + &WARN("chanServCheck: chan == NULL."); + return; + } + + if ($chan =~ tr/A-Z/a-z/) { + &DEBUG("chanServCheck: lowercased chan ($chan)"); + } + + if (! &IsChanConf("chanServ_ops") ) { + return; + } + + &DEBUG("chanServCheck($chan) called."); + + if ( &IsParam("nickServ_pass") and !$nickserv) { + &DEBUG("chanServ_ops($_): nickserv enabled but not alive? (ircCheck)"); + return; + } + return if (exists $channels{$chan}{'o'}{$ident}); + + &status("ChanServ ==> Requesting ops for $chan. (chanServCheck)"); + &rawout("PRIVMSG ChanServ :OP $chan $ident"); +} + 1; diff --git a/src/IRC/IrcHooks.pl b/src/IRC/IrcHooks.pl index d2bd05a..56e9760 100644 --- a/src/IRC/IrcHooks.pl +++ b/src/IRC/IrcHooks.pl @@ -119,7 +119,7 @@ sub on_chat { } else { # dcc chat arena. - foreach (keys %{$dcc{'CHAT'}}) { + foreach (keys %{ $dcc{'CHAT'} }) { $conn->privmsg($dcc{'CHAT'}{$_}, "<$who> $orig{message}"); } } @@ -167,7 +167,12 @@ sub on_endofmotd { } if (&IsParam("ircUMode")) { - &status("Attempting change of user modes to $param{'ircUMode'}."); + &VERB("Attempting change of user modes to $param{'ircUMode'}.", 2); + if ($param{'ircUMode'} !~ /^[-+]/) { + &WARN("ircUMode had no +- prefix; adding +"); + $param{'ircUMode'} = "+".$param{'ircUMode'}; + } + &rawout("MODE $ident $param{'ircUMode'}"); } @@ -177,6 +182,10 @@ sub on_endofmotd { @joinchan = &getJoinChans(); } + # unfortunately, Net::IRC does not implement this :( + &rawout("NOTIFY $ident"); + &DEBUG("adding self to NOTIFY list."); + &joinNextChan(); } @@ -333,6 +342,7 @@ sub on_endofnames { my ($self, $event) = @_; my $chan = ($event->args)[1]; + # sync time should be done in on_endofwho like in BitchX if (exists $cache{jointime}{$chan}) { my $delta_time = sprintf("%.03f", &gettimeofday() - $cache{jointime}{$chan}); $delta_time = 0 if ($delta_time < 0); @@ -357,19 +367,10 @@ sub on_endofnames { my $chanstats = join(' || ', @array); &status("$b_blue$chan$ob: [$chanstats]"); + &joinNextChan(); if (scalar @joinchan) { # remaining channels to join. + # lets do two at once! &joinNextChan(); - } else { - &DEBUG("running ircCheck to get chanserv ops."); - &ircCheck(); - } - - return unless (&IsChanConf("chanServ_ops") > 0); - return unless ($nickserv); - - if (!exists $channels{$chan}{'o'}{$ident}) { - &status("ChanServ ==> Requesting ops for $chan. (2)"); - &rawout("PRIVMSG ChanServ :OP $chan $ident"); } } @@ -398,8 +399,8 @@ sub on_invite { next; } - &status("invited to $b_blue$_$ob by $b_cyan$who$ob"); - &joinchan($self, $_); + &status("invited to $b_blue$chan$ob by $b_cyan$nick$ob"); + &joinchan($chan); } } @@ -608,7 +609,7 @@ sub on_nick { my ($chan,$mode); foreach $chan (keys %channels) { - foreach $mode (keys %{$channels{$chan}}) { + foreach $mode (keys %{ $channels{$chan} }) { next unless (exists $channels{$chan}{$mode}{$nick}); $channels{$chan}{$mode}{$newnick} = $channels{$chan}{$mode}{$nick}; @@ -755,8 +756,8 @@ sub on_public { foreach $chan (grep /[A-Z]/, keys %channels) { &DEBUG("leak: chan => '$chan'."); my ($i,$j); - foreach $i (keys %{$channels{$chan}}) { - foreach (keys %{$channels{$chan}{$i}}) { + foreach $i (keys %{ $channels{$chan} }) { + foreach (keys %{ $channels{$chan}{$i} }) { &DEBUG("leak: \$channels{$chan}{$i}{$_} ..."); } } @@ -975,4 +976,36 @@ sub on_whoisuser { $nuh{lc $args[1]} = $args[1]."!".$args[2]."\@".$args[3]; } +### +### since joinnextchan is hooked onto on_endofnames, these are needed. +### + +sub on_chanfull { + my ($self, $event) = @_; + my @args = $event->args; + &DEBUG("on_chanfull: args => @args"); + &joinNextChan(); +} + +sub on_inviteonly { + my ($self, $event) = @_; + my @args = $event->args; + &DEBUG("on_inviteonly: args => @args"); + &joinNextChan(); +} + +sub on_banned { + my ($self, $event) = @_; + my @args = $event->args; + &DEBUG("on_banned: args => @args"); + &joinNextChan(); +} + +sub on_badchankey { + my ($self, $event) = @_; + my @args = $event->args; + &DEBUG("on_badchankey: args => @args"); + &joinNextChan(); +} + 1; diff --git a/src/IRC/Schedulers.pl b/src/IRC/Schedulers.pl index 9ad8d8a..7519ef0 100644 --- a/src/IRC/Schedulers.pl +++ b/src/IRC/Schedulers.pl @@ -29,7 +29,7 @@ sub setupSchedulers { &leakCheck(2); # mandatory &ignoreCheck(1); # mandatory &seenFlushOld(2); - &ircCheck(1); # mandatory + &ircCheck(2); # mandatory &miscCheck(1); # mandatory &miscCheck2(2); # mandatory &shmFlush(1); # mandatory @@ -356,10 +356,10 @@ sub chanlimitCheck { next unless (&validChan($chan)); my $limitplus = &getChanConfDefault("chanlimitcheckPlus", 5, $chan); - my $newlimit = scalar(keys %{$channels{$chan}{''}}) + $limitplus; + my $newlimit = scalar(keys %{ $channels{$chan}{''} }) + $limitplus; my $limit = $channels{$chan}{'l'}; - if (defined $limit and scalar keys %{$channels{$chan}{''}} > $limit) { + if (defined $limit and scalar keys %{ $channels{$chan}{''} } > $limit) { &FIXME("LIMIT: set too low!!! FIXME"); ### run NAMES again and flush it. } @@ -369,7 +369,7 @@ sub chanlimitCheck { if (!exists $channels{$chan}{'o'}{$ident}) { &status("ChanLimit: dont have ops on $chan.") unless (exists $cache{warn}{chanlimit}{$chan}); $cache{warn}{chanlimit}{$chan} = 1; - ### TODO: check chanserv? + &chanServCheck($chan); next; } delete $cache{warn}{chanlimit}{$chan}; @@ -378,8 +378,8 @@ sub chanlimitCheck { &status("ChanLimit: setting for first time or from netsplit, for $chan"); } - if (exists $cache{ "chanlimitChange_$chan" }) { - my $delta = time() - $cache{ "chanlimitChange_$chan" }; + if (exists $cache{chanlimitChange}{$chan}) { + my $delta = time() - $cache{chanlimitChange}{$chan}; if ($delta < $interval*60) { &DEBUG("not going to change chanlimit! ($delta<$interval*60)"); return; @@ -387,7 +387,7 @@ sub chanlimitCheck { } &rawout("MODE $chan +l $newlimit"); - $cache{ "chanlimitChange_$chan" } = time(); + $cache{chanlimitChange}{$chan} = time(); } } @@ -402,7 +402,7 @@ sub netsplitCheck { } foreach $s1 (keys %netsplitservers) { - foreach $s2 (keys %{$netsplitservers{$s1}}) { + foreach $s2 (keys %{ $netsplitservers{$s1} }) { if (time() - $netsplitservers{$s1}{$s2} > 3600) { &status("netsplit between $s1 and $s2 appears to be stale."); delete $netsplitservers{$s1}{$s2}; @@ -445,7 +445,7 @@ sub floodLoop { my $interval = &getChanConfDefault("floodCycle",60); foreach $who (keys %flood) { - foreach (keys %{$flood{$who}}) { + foreach (keys %{ $flood{$who} }) { if (!exists $flood{$who}{$_}) { &WARN("flood{$who}{$_} undefined?"); next; @@ -639,7 +639,6 @@ sub ignoreCheck { } sub ircCheck { - if (@_) { &ScheduleThis(60, "ircCheck"); return if ($_[0] eq "2"); # defer. @@ -654,14 +653,6 @@ sub ircCheck { &FIXME("ircCheck: current channels * 2 <= config channels. FIXME."); } - # chanserv ops. - foreach ( &ChanConfList("chanServ_ops") ) { - next if (exists $channels{$chan}{'o'}{$ident}); - - &status("ChanServ ==> Requesting ops for $chan. (3)"); - &rawout("PRIVMSG ChanServ :OP $chan $ident"); - } - if (!$conn->connected or time() - $msgtime > 3600) { # todo: shouldn't we use cache{connect} somewhere? if (exists $cache{connect}) { @@ -680,6 +671,8 @@ sub ircCheck { if ($ident !~ /^\Q$param{ircNick}\E$/) { # this does not work unfortunately. &WARN("ircCheck: ident($ident) != param{ircNick}($param{IrcNick})."); + + # this check is misleading... perhaps we should do a notify. if (! &IsNickInAnyChan( $param{ircNick} ) ) { &DEBUG("$param{ircNick} not in use... changing!"); &nick( $param{ircNick} ); @@ -688,10 +681,6 @@ sub ircCheck { } } - &joinNextChan(); - # if scalar @joinnext => join more channels - # else check for chanserv. - if (grep /^\s*$/, keys %channels) { &WARN("ircCheck: we have a NULL chan in hash channels? removing!"); if (exists $channels{''}) { diff --git a/src/Misc.pl b/src/Misc.pl index be5e034..3db0cdc 100644 --- a/src/Misc.pl +++ b/src/Misc.pl @@ -208,7 +208,7 @@ sub fixFileList { # sort the hash list appropriately. foreach (sort keys %files) { my $file = $_; - my @keys = sort keys %{$files{$file}}; + my @keys = sort keys %{ $files{$file} }; my $i = scalar(@keys); if ($i > 1) { diff --git a/src/Modules/Debian.pl b/src/Modules/Debian.pl index eea5d94..4aa912f 100644 --- a/src/Modules/Debian.pl +++ b/src/Modules/Debian.pl @@ -278,7 +278,7 @@ sub searchContents { } foreach $pkg (keys %contents) { - foreach (keys %{$contents{$pkg}}) { + foreach (keys %{ $contents{$pkg} }) { # TODO: correct padding. print OUT "$_\t\t\t$pkg\n"; } @@ -294,7 +294,7 @@ sub searchContents { my @list; foreach $pkg (keys %contents) { - my @tmplist = &::fixFileList(keys %{$contents{$pkg}}); + my @tmplist = &::fixFileList(keys %{ $contents{$pkg} }); my @sublist = sort { length $a <=> length $b } @tmplist; pop @sublist while (scalar @sublist > 3); @@ -398,7 +398,7 @@ sub searchAuthor { my $name; foreach $name (keys %maint) { my $email; - foreach $email (keys %{$maint{$name}}) { + foreach $email (keys %{ $maint{$name} }) { next unless ($email =~ /\Q$query\E/i); next if (exists $hash{$name}); $hash{$name} = 1; @@ -415,13 +415,13 @@ sub searchAuthor { &::DEBUG("showing all packages by '$list[0]'..."); - my @pkg = sort keys %{$pkg{$list[0]}}; + my @pkg = sort keys %{ $pkg{$list[0]} }; # show how long it took. my $delta_time = &::timedelta($start_time); &::status(sprintf("Debian: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0); - my $email = join(', ', keys %{$maint{$list[0]}}); + my $email = join(', ', keys %{ $maint{$list[0]} }); my $prefix = "Debian Packages by $list[0] \002<\002$email\002>\002 "; &::pSReply( &::formListReply(0, $prefix, @pkg) ); } @@ -809,14 +809,14 @@ sub infoStats { &::pSReply( "Debian Distro Stats on $dist... ". "\002$total{'count'}\002 packages, ". - "\002".scalar(keys %{$total{'maint'}})."\002 maintainers, ". + "\002".scalar(keys %{ $total{'maint'} })."\002 maintainers, ". "\002". int($total{'isize'}/1024)."\002 MB installed size, ". "\002". int($total{'csize'}/1024/1024)."\002 MB compressed size." ); ### TODO: do individual stats? if so, we need _another_ arg. # foreach $file (keys %stats) { -# foreach (keys %{$stats{$file}}) { +# foreach (keys %{ $stats{$file} }) { # &::DEBUG(" '$file' '$_' '$stats{$file}{$_}'."); # } # } diff --git a/src/Modules/DebianExtra.pl b/src/Modules/DebianExtra.pl index 52733e6..f617934 100644 --- a/src/Modules/DebianExtra.pl +++ b/src/Modules/DebianExtra.pl @@ -7,10 +7,35 @@ use strict; -my $bugs_url = "http://master.debian.org/~wakkerma/bugs"; +package DBugs; + +sub Parse { + my($args) = @_; + + if (!defined $args or $args =~ /^$/) { + &debianBugs(); + } + + if ($args =~ /^(\d+)$/) { + # package number: + &do_id($args); + + } elsif ($args =~ /^(\S+\@\S+)$/) { + # package email maintainer. + &do_email($args); + + } elsif ($args =~ /^(\S+)$/) { + # package name. + &do_pkg($args); + + } else { + # invalid. + &::msg($::who, "error: could not parse $args"); + } +} sub debianBugs { - my @results = &::getURL($bugs_url); + my @results = &::getURL("http://master.debian.org/~wakkerma/bugs"); my ($date, $rcbugs, $remove); my ($bugs_closed, $bugs_opened) = (0,0); @@ -40,4 +65,44 @@ sub debianBugs { } } +sub do_id { + my($num) = @_; + my $url = "http://bugs.debian.org/$num"; + + if (1) { + &::msg($::who, "do_id not supported yet."); + return; + } + + my @results = &::getURL($url); + foreach (@results) { + &::DEBUG("do_id: $_"); + } +} + +sub do_email { + my($email) = @_; + my $url = "http://bugs.debian.org/$email"; + + if (1) { + &::msg($::who, "do_email not supported yet."); + return; + } + + my @results = &::getURL($url); + foreach (@results) { + &::DEBUG("do_email: $_"); + } +} + +sub do_pkg { + my($pkg) = @_; + my $url = "http://bugs.debian.org/$pkg"; + + my @results = &::getURL($url); + foreach (@results) { + &::DEBUG("do_pkg: $_"); + } +} + 1; diff --git a/src/Modules/Factoids.pl b/src/Modules/Factoids.pl index 46cbf8d..f223f91 100644 --- a/src/Modules/Factoids.pl +++ b/src/Modules/Factoids.pl @@ -167,7 +167,7 @@ sub CmdFactStats { my $count; my @list; foreach $count (sort { $b <=> $a } keys %count) { - my $author = join(", ", sort keys %{$count{$count}}); + my $author = join(", ", sort keys %{ $count{$count} }); push(@list, "$count by $author"); } @@ -246,11 +246,11 @@ sub CmdFactStats { my $v; foreach $v (keys %hash) { - my $count = scalar(keys %{$hash{$v}}); + my $count = scalar(keys %{ $hash{$v} }); next if ($count == 1); my @sublist; - foreach (keys %{$hash{$v}}) { + foreach (keys %{ $hash{$v} }) { if ($v =~ /^ see /i) { $refs++; next; @@ -384,7 +384,7 @@ sub CmdFactStats { my @list; foreach (sort {$a <=> $b} keys %age) { - push(@list, join(",", keys %{$age{$_}})); + push(@list, join(",", keys %{ $age{$_} })); } my $prefix = "new factoids in the last 24hours "; @@ -421,7 +421,7 @@ sub CmdFactStats { my @sublist; my $length; foreach $length (@length) { - foreach (keys %{$length{$length}}) { + foreach (keys %{ $length{$length} }) { if ($key{$_} =~ /^$val/i) { s/([\,\;]+)/\037$1\037/g; s/( and|and )/\037$1\037/g; @@ -478,7 +478,7 @@ sub CmdFactStats { my @newlist; foreach $f (keys %redir) { - my @sublist = keys %{$redir{$f}}; + my @sublist = keys %{ $redir{$f} }; for (@sublist) { s/([\,\;]+)/\037$1\037/g; } @@ -533,7 +533,7 @@ sub CmdFactStats { # work-around. my %count; foreach (keys %requester) { - $count{$requester{$_}}{$_} = 1; + $count{ $requester{$_} }{$_} = 1; } undef %requester; diff --git a/src/Modules/Topic.pl b/src/Modules/Topic.pl index ac24b14..60e5c3b 100644 --- a/src/Modules/Topic.pl +++ b/src/Modules/Topic.pl @@ -418,14 +418,14 @@ sub Topic { } elsif ($cmd =~ /^(history)$/i) { ### CMD: HISTORY: - if (!scalar @{$topic{$chan}{'History'}}) { + if (!scalar @{ $topic{$chan}{'History'} }) { &msg($who, "Sorry, no topics in history list."); return; } &msg($who, "History of topics on \002$chan\002:"); - for (1 .. scalar @{$topic{$chan}{'History'}}) { - my $topic = ${$topic{$chan}{'History'}}[$_-1]; + for (1 .. scalar @{ $topic{$chan}{'History'} }) { + my $topic = ${ $topic{$chan}{'History'} }[$_-1]; &msg($who, " #\002$_\002: $topic"); # To prevent excess floods. @@ -444,7 +444,7 @@ sub Topic { # following needs to be verified. if ($args =~ /^last$/i) { - if (${$topic{$chan}{'History'}}[0] eq $topic{$chan}{'Current'}) { + if (${ $topic{$chan}{'History'} }[0] eq $topic{$chan}{'Current'}) { &msg($who,"error: cannot restore last topic because it's mine."); return; } @@ -452,13 +452,13 @@ sub Topic { } if ($args =~ /\d+/) { - if ($args > $#{$topic{$chan}{'History'}} || $args < 1) { + if ($args > $#{ $topic{$chan}{'History'} } || $args < 1) { &msg($who, "error: argument is out of range."); return; } $_ = "Changing topic according to request."; - &topicNew($chan, ${$topic{$chan}{'History'}}[$args-1], $_, $topicUpdate); + &topicNew($chan, ${ $topic{$chan}{'History'} }[$args-1], $_, $topicUpdate); return; } diff --git a/src/Modules/Units.pl b/src/Modules/Units.pl index e51e612..3aea582 100644 --- a/src/Modules/Units.pl +++ b/src/Modules/Units.pl @@ -38,7 +38,7 @@ BEGIN { yotta => 21, zetta => 24, ); - $PREF = join '|', sort {$PREF{$a} <=> $PREF{$b}} (keys %PREF); + $PREF = join '|', sort { $PREF{$a} <=> $PREF{$b} } (keys %PREF); } diff --git a/src/Modules/Uptime.pl b/src/Modules/Uptime.pl index 1756f7b..1d8e927 100644 --- a/src/Modules/Uptime.pl +++ b/src/Modules/Uptime.pl @@ -51,7 +51,7 @@ sub uptimeGetInfo { # should be no problems, even if uptime or pid is duplicated. ## WARN: run away forks may get through here, have to fix. foreach $uptime (sort {$b <=> $a} keys %uptime) { - foreach $pid (keys %{$uptime{$uptime}}) { + foreach $pid (keys %{ $uptime{$uptime} }) { next if (exists $done{$pid}); push(@results,"$uptime.$pid $uptime{$uptime}{$pid}"); diff --git a/src/Modules/UserDCC.pl b/src/Modules/UserDCC.pl index 06fe68c..4be0e86 100644 --- a/src/Modules/UserDCC.pl +++ b/src/Modules/UserDCC.pl @@ -24,11 +24,11 @@ sub userDCC { # who. if ($message =~ /^who$/) { - my $count = scalar(keys %{$dcc{'CHAT'}}); + my $count = scalar(keys %{ $dcc{'CHAT'} }); my $dccCHAT = $message; &pSReply("Start of who ($count users)."); - foreach (keys %{$dcc{'CHAT'}}) { + foreach (keys %{ $dcc{'CHAT'} }) { &pSReply("=> $_"); } &pSReply("End of who."); diff --git a/src/Process.pl b/src/Process.pl index 259fcdb..495c00b 100644 --- a/src/Process.pl +++ b/src/Process.pl @@ -188,11 +188,11 @@ sub process { # override msgType. if ($msgType =~ /public/ and $message =~ s/^\+//) { - &status("found '+' flag; setting msgType to public."); - $force_public_reply++; + &status("Process: '+' flag detected; changing reply to public"); $msgType = 'public'; $who = $chan; # major hack to fix &msg(). - &DEBUG("addressed => $addressed."); + $force_public_reply++; + # notice is still NOTICE but to whole channel => good. } # User Processing, for all users. @@ -263,7 +263,7 @@ sub process { if ($message =~ /^than(ks?|x)( you)?( \S+)?/i) { return 'thank: no addr' unless ($message =~ /$ident/ or $talkok); - &performReply( &getRandom(keys %{$lang{'welcome'}}) ); + &performReply( &getRandom(keys %{ $lang{'welcome'} }) ); return; } @@ -634,6 +634,7 @@ sub FactoidStuff { my $newresult = &perlMath(); if (defined $newresult and $newresult ne "") { + $cmdstats{'Maths'}++; $result = $newresult; &status("math: <$who> $message => $result"); } @@ -658,13 +659,13 @@ sub FactoidStuff { if (length $message > 64) { &status("unparseable-moron: $message"); - &performReply( &getRandom(keys %{$lang{'moron'}}) ); + &performReply( &getRandom(keys %{ $lang{'moron'} }) ); $count{'Moron'}++; return; } &status("unparseable: $message"); - &performReply( &getRandom(keys %{$lang{'dunno'}}) ); + &performReply( &getRandom(keys %{ $lang{'dunno'} }) ); $count{'Dunno'}++; } diff --git a/src/UserExtra.pl b/src/UserExtra.pl index dae2d6b..101b95c 100644 --- a/src/UserExtra.pl +++ b/src/UserExtra.pl @@ -60,13 +60,13 @@ sub chaninfo { &ircCheck(); next; } - push(@array, "$_ (".scalar(keys %{$channels{$_}{''}}).")"); + push(@array, "$_ (".scalar(keys %{ $channels{$_}{''} }).")"); } &pSReply($reply.": ".join(' ', @array)); ### total user count. foreach $chan (keys %channels) { - $tucount += scalar(keys %{$channels{$chan}{''}}); + $tucount += scalar(keys %{ $channels{$chan}{''} }); } ### unique user count. @@ -103,7 +103,7 @@ sub chaninfo { # Step 1: my @array; - foreach (sort keys %{$chanstats{$chan}}) { + foreach (sort keys %{ $chanstats{$chan} }) { my $int = $chanstats{$chan}{$_}; next unless ($int); @@ -123,7 +123,7 @@ sub chaninfo { - $chanstats{$chan}{'Part'}; if ($delta_stats) { - my $total = scalar(keys %{$channels{$chan}{''}}); + my $total = scalar(keys %{ $channels{$chan}{''} }); &status("chaninfo: join ~= signoff + part (drift of $delta_stats < $total)."); if ($delta_stats > $total) { @@ -135,7 +135,7 @@ sub chaninfo { undef @array; my $type; foreach ("v","o","") { - my $int = scalar(keys %{$channels{$chan}{$_}}); + my $int = scalar(keys %{ $channels{$chan}{$_} }); next unless ($int); $type = "Voice" if ($_ eq "v"); @@ -167,14 +167,14 @@ sub cmdstats { my %countstats; foreach (keys %cmdstats) { - $countstats{$cmdstats{$_}}{$_} = 1; + $countstats{ $cmdstats{$_} }{$_} = 1; } foreach (sort {$b <=> $a} keys %countstats) { my $int = $_; next unless ($int); - foreach (keys %{$countstats{$int}}) { + foreach (keys %{ $countstats{$int} }) { push(@array, "\002$int\002 of $_"); } } @@ -638,7 +638,7 @@ sub userCommands { my $p = sprintf("%.02f", $connectivity); $p =~ s/(\.\d*)0+$/$1/; if ($p =~ s/\.0$//) { - &DEBUG("p sar not working properly :("); + # this should not happen... but why... } else { $p =~ s/\.$// } @@ -662,7 +662,7 @@ sub userCommands { ### REASON. my $reason = $ircstats{'DisconnectReason'}; if (defined $reason) { - $reply .= " I was last disconnected for '$reason'."; + $reply .= ". I was last disconnected for '$reason'."; } &pSReply($reply); -- 2.39.2