X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=src%2FUserExtra.pl;h=9923a092115a3aa652ae4c7d241a1d12bef254fb;hb=c6ea16a8cf7e3bc0e1ef68d6f795520e6db4aebe;hp=e998be4b1fe7de846bf513cdfca6a2b0aba77587;hpb=d08ee60da7b30623c32a999f3c2d079e256068c8;p=infobot.git diff --git a/src/UserExtra.pl b/src/UserExtra.pl index e998be4..9923a09 100644 --- a/src/UserExtra.pl +++ b/src/UserExtra.pl @@ -24,15 +24,17 @@ use vars qw(%channels %chanstats %cmdstats); &addCmdHook("main", 'help', ('CODEREF' => 'help', 'Cmdstats' => 'Help', ) ); &addCmdHook("main", 'karma', ('CODEREF' => 'karma', ) ); -&addCmdHook("main", 'ignorelist', ('CODEREF' => 'ignorelist', ) ); &addCmdHook("main", 'i?spell', ('CODEREF' => 'ispell', Help => 'spell', Identifier => 'spell', ) ); &addCmdHook("main", 'd?nslookup', ('CODEREF' => 'DNS', Help => 'nslookup', Identifier => 'allowDNS', Forker => "NULL", ) ); &addCmdHook("main", 'tell|explain', ('CODEREF' => 'tell', - Help => 'tell', Identifier => 'allowTelling', ) ); - + Help => 'tell', Identifier => 'allowTelling', + Cmdstats => 'Tell') ); +&addCmdHook("main", 'news', ('CODEREF' => 'News::Parse', + Module => 'news', ) ); +# Module => 'news', Identifier => 'news') ); &status("CMD: loaded ".scalar(keys %hooks_main)." MAIN command hooks."); @@ -45,9 +47,10 @@ sub chaninfo { my $mode; if ($chan eq "") { # all channels. - my $count = 0; my $i = keys %channels; my $reply = "i am on \002$i\002 ".&fixPlural("channel",$i); + my $tucount = 0; # total user count. + my $uucount = 0; # unique user count. my @array; ### line 1. @@ -57,38 +60,50 @@ sub chaninfo { &ircCheck(); next; } - push(@array, "$_ (".scalar(keys %{$channels{$_}{''}}).")"); + push(@array, "$_ (".scalar(keys %{ $channels{$_}{''} }).")"); } - &performStrictReply($reply.": ".join(' ', @array)); + &pSReply($reply.": ".join(' ', @array)); - ### line 2. + ### total user count. foreach $chan (keys %channels) { - # crappy debugging... - # TODO: use $mask{chan} instead? - if ($chan =~ / /) { - &ERROR("bad channel: chan => '$chan'."); + $tucount += scalar(keys %{ $channels{$chan}{''} }); + } + + ### unique user count. + my @nicks; + foreach $chan (keys %channels) { + foreach (keys %{ $channels{$chan}{''} }) { + next if (grep /^\Q$_\E$/, @nicks); + $uucount++; + push(@nicks, $_); } - $count += scalar(keys %{$channels{$chan}{''}}); } - &performStrictReply( - "i've cached \002$count\002 ".&fixPlural("user",$count). - " distributed over \002".scalar(keys %channels)."\002 ". - &fixPlural("channel",scalar(keys %channels))."." + &DEBUG("nicks => '".scalar(@nicks)."'..."); + if (scalar @nicks != $uucount) { + &DEBUG("nicks != uucount..."); + } + + my $chans = scalar(keys %channels); + &pSReply( + "i've cached \002$tucount\002 ". &fixPlural("user",$tucount). + ", \002$uucount\002 unique ". &fixPlural("user",$uucount). + ", distributed over \002$chans\002 ". + &fixPlural("channel", $chans)."." ); - return $noreply; + return; } # channel specific. if (&validChan($chan) == 0) { &msg($who,"error: invalid channel \002$chan\002"); - return $noreply; + return; } # Step 1: my @array; - foreach (sort keys %{$chanstats{$chan}}) { + foreach (sort keys %{ $chanstats{$chan} }) { my $int = $chanstats{$chan}{$_}; next unless ($int); @@ -108,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) { @@ -120,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"); @@ -138,7 +153,7 @@ sub chaninfo { if ($count) { $reply .= ". \002$new{$count}\002 has said the most with a total of \002$count\002 messages"; } - &performStrictReply("$reply."); + &pSReply("$reply."); } # Command statistics. @@ -147,23 +162,23 @@ sub cmdstats { if (!scalar(keys %cmdstats)) { &performReply("no-one has run any commands yet"); - return $noreply; + return; } 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 $_"); } } - &performStrictReply("command usage include ". &IJoin(@array)."."); + &pSReply("command usage include ". &IJoin(@array)."."); } # Factoid extension info. xk++ @@ -174,7 +189,7 @@ sub factinfo { if ($faqtoid =~ /^\-(\S+)(\s+(.*))$/) { &msg($who,"error: individual factoid info queries not supported as yet."); &msg($who,"it's possible that the factoid mistakenly begins with '-'."); - return $noreply; + return; $query = lc $1; $faqtoid = lc $3; @@ -187,7 +202,7 @@ sub factstats { my $type = shift(@_); &Forker("factoids", sub { - &performStrictReply( &CmdFactStats($type) ); + &pSReply( &CmdFactStats($type) ); } ); } @@ -196,46 +211,9 @@ sub karma { my $karma = &dbGet("karma", "nick",$target,"karma") || 0; if ($karma != 0) { - &performStrictReply("$target has karma of $karma"); + &pSReply("$target has karma of $karma"); } else { - &performStrictReply("$target has neutral karma"); - } -} - -sub ignorelist { - &status("$who asked for the ignore list"); - - my $time = time(); - my $count = scalar(keys %ignoreList); - my $counter = 0; - my @array; - - if ($count == 0) { - &performStrictReply("no one in the ignore list!!!"); - return; - } - - foreach (sort keys %ignoreList) { - my $str; - - if ($ignoreList{$_} != 1) { # temporary ignore. - my $expire = $ignoreList{$_} - $time; - if (defined $expire and $expire < 0) { - &status("ignorelist: deleting $_."); - delete $ignoreList{$_}; - } else { - $str = "$_ (". &Time2String($expire) .")"; - } - } else { - $str = $_; - } - - push(@array,$str); - $counter++; - if (scalar @array >= 8 or $counter == $count) { - &msg($who, &formListReply(0, "Ignore list ", @array) ); - @array = (); - } + &pSReply("$target has neutral karma"); } } @@ -277,7 +255,7 @@ sub ispell { } } - &performStrictReply($reply); + &pSReply($reply); } sub nslookup { @@ -289,6 +267,7 @@ sub nslookup { sub tell { my $args = shift; my ($target, $tell_obj) = ('',''); + my $dont_tell_me = 0; my $reply; ### is this fixed elsewhere? @@ -296,9 +275,10 @@ sub tell { $args =~ s/^\s+|\s+$//g; # again. # this one catches most of them - if ($args =~ /^(\S+) about (.*)$/i) { + if ($args =~ /^(\S+) (-?)about (.*)$/i) { $target = lc $1; - $tell_obj = $2; + $tell_obj = $3; + $dont_tell_me = ($2) ? 1 : 0; $tell_obj = $who if ($tell_obj =~ /^(me|myself)$/i); $query = $tell_obj; @@ -330,12 +310,12 @@ sub tell { $target = $talkchannel if ($target =~ /^us$/i); $target = $who if ($target =~ /^(me|myself)$/i); - &status("target: $target query: $query"); + &status("tell: target = $target, query = $query"); # "intrusive". if ($target !~ /^$mask{chan}$/ and !&IsNickInAnyChan($target)) { &msg($who, "No, $target is not in any of my chans."); - return $noreply; + return; } ### TODO: don't "tell" if sender is not in target's channel. @@ -343,23 +323,51 @@ sub tell { # self. if ($target eq $ident) { # lc? &msg($who, "Isn't that a bit silly?"); - return $noreply; + return; } - # ... + my $oldwho = $who; + my $oldmtype = $msgType; + $who = $target; my $result = &doQuestion($tell_obj); - return if ($result eq $noreply); + # ^ returns '0' if nothing was found. + $who = $oldwho; # no such factoid. - if ($result eq "") { - &msg($who, "i dunno what is '$tell_obj'."); + if ($result =~ /^0?$/) { + $who = $target; + $msgType = "private"; + + # support command redirection. + # recursive cmdHooks aswell :) + my $done = 0; + $done++ if &parseCmdHook("main", $tell_obj); + $done++ if &parseCmdHook("extra", $tell_obj); + $message = $tell_obj; + $done++ unless (&Modules()); + + &DEBUG("setting old values of who and msgType."); + $who = $oldwho; + $msgType = $oldmtype; + + if ($done) { + &msg($who, "told $target about CMD '$tell_obj'"); + } else { + &msg($who, "i dunno what is '$tell_obj'."); + } + return; } # success. &status("tell: <$who> telling $target about $tell_obj."); if ($who ne $target) { - &msg($who, "told $target about $tell_obj ($result)"); + if ($dont_tell_me) { + &msg($who, "told $target about $tell_obj."); + } else { + &msg($who, "told $target about $tell_obj ($result)"); + } + $reply = "$who wants you to know: $result"; } else { $reply = "telling yourself: $result"; @@ -406,24 +414,20 @@ sub DNS { sub userCommands { # conversion: ascii. if ($message =~ /^(asci*|chr) (\d+)$/) { - return '' unless (&IsParam("allowConv")); + return unless (&IsParam("allowConv")); - $arg = $2; - if ($arg < 32) { - $arg += 64; - $result = "^".chr($arg); - } else { - $result = chr($2); - } - $result = "NULL" if ($arg == 0); + $arg = $2; + $result = chr($arg); + $result = "NULL" if ($arg == 0); &performReply( sprintf("ascii %s is '%s'", $arg, $result) ); - return $noreply; + + return; } # conversion: ord. if ($message =~ /^ord (.)$/) { - return '' unless (&IsParam("allowConv")); + return unless (&IsParam("allowConv")); $arg = $1; if (ord($arg) < 32) { @@ -436,21 +440,22 @@ sub userCommands { } &performReply( sprintf("'%s' is ascii %s", $arg, ord $1) ); - return $noreply; + return; } # hex. if ($message =~ /^hex(\s+(.*))?$/i) { + return unless (&IsParam("allowConv")); my $arg = $2; if (!defined $arg) { &help("hex"); - return $noreply; + return; } if (length $arg > 80) { &msg($who, "Too long."); - return $noreply; + return; } my $retval; @@ -458,23 +463,37 @@ sub userCommands { $retval .= sprintf(" %X", ord($_)); } - &performStrictReply("$arg is$retval"); + &pSReply("$arg is$retval"); - return $noreply; + return; } # crypt. - if ($message =~ /^crypt\s+(\S+)\s*(?:,| )\s*(\S+)/) { - # word salt. - &performStrictReply(crypt($1, $2)); - return $noreply; - } + if ($message =~ /^crypt(\s+(.*))?$/i) { + my @args = split /\s+/, $2; + if (!scalar @args or scalar @args > 2) { + &help("crypt"); + return; + } + + if (scalar @args == 2) { + if (length $args[0] != 2) { + &msg($who, "invalid format..."); + return; + } + + &pSReply( crypt($args[1], $args[0]) ); + } else { + &pSReply( &mkcrypt($args[0]) ); + } + return; + } # cycle. if ($message =~ /^(cycle)(\s+(\S+))?$/i) { - return $noreply unless (&hasFlag("o")); + return unless (&hasFlag("o")); my $chan = lc $3; if ($chan eq "") { @@ -483,13 +502,13 @@ sub userCommands { &DEBUG("cycle: setting chan to '$chan'."); } else { &help("cycle"); - return $noreply; + return; } } if (&validChan($chan) == 0) { &msg($who,"error: invalid channel \002$chan\002"); - return $noreply; + return; } &msg($chan, "I'm coming back. (courtesy of $who)"); @@ -498,23 +517,23 @@ sub userCommands { &status("Schedule rejoin in 5secs to $chan by $who."); $conn->schedule(5, sub { &joinchan($chan); }); - return $noreply; + return; } # redir. if ($message =~ /^redir(\s+(.*))?/i) { - return $noreply unless (&hasFlag("o")); + return unless (&hasFlag("o")); my $factoid = $2; if (!defined $factoid) { &help("redir"); - return $noreply; + return; } my $val = &getFactInfo($factoid, "factoid_value"); if (!defined $val or $val eq "") { &msg($who, "error: '$factoid' does not exist."); - return $noreply; + return; } &DEBUG("val => '$val'."); my @list = &searchTable("factoids", "factoid_key", @@ -522,51 +541,57 @@ sub userCommands { if (scalar @list == 1) { &msg($who, "hrm... '$factoid' is unique."); - return $noreply; + return; } if (scalar @list > 5) { &msg($who, "A bit too many factoids to be redirected, hey?"); - return $noreply; + return; } my @redir; &status("Redirect '$factoid' (". ($#list) .")..."); for (@list) { + my $x = $_; next if (/^\Q$factoid\E$/i); &status(" Redirecting '$_'."); my $was = &getFactoid($_); + if ($was =~ / see/i) { + &status("warn: not redirecting a redirection."); + next; + } + &DEBUG(" was '$was'."); - push(@redir,$_); - &setFactInfo($_, "factoid_value", " see $factoid"); + push(@redir,$x); + &setFactInfo($x, "factoid_value", " see $factoid"); } &status("Done."); &msg($who, &formListReply(0, "'$factoid' is redirected to by '", @redir)); - return $noreply; + return; } # rot13 it. if ($message =~ /^rot13(\s+(.*))?/i) { my $reply = $2; - if ($reply eq "") { + if (!defined $reply) { &help("rot13"); - return $noreply; + return; } $reply =~ y/A-Za-z/N-ZA-Mn-za-m/; - &performStrictReply($reply); + &pSReply($reply); - return $noreply; + return; } # cpustats. if ($message =~ /^cpustats$/i) { if ($^O !~ /linux/) { &ERROR("cpustats: your OS is not supported yet."); - return $noreply; + return; } ### poor method to get info out of file, please fix. @@ -590,21 +615,37 @@ sub userCommands { $perc = sprintf("%.03f", $raw_perc); } - &performStrictReply("Total CPU usage: $cpu_usage s ... Percentage CPU used: $perc %"); + &pSReply("Total CPU usage: $cpu_usage s ... Percentage CPU used: $perc %"); &DEBUG("15 => $data[15] (cutime)"); &DEBUG("16 => $data[16] (cstime)"); - return $noreply; + return; } # ircstats. - if ($message =~ /^ircstats$/i) { + if ($message =~ /^ircstats?$/i) { + $ircstats{'TotalTime'} ||= 0; + $ircstats{'OffTime'} ||= 0; + my $count = $ircstats{'ConnectCount'}; my $format_time = &Time2String(time() - $ircstats{'ConnectTime'}); + my $total_time = time() - $ircstats{'ConnectTime'} + + $ircstats{'TotalTime'}; my $reply; - foreach (keys %ircstats) { - &DEBUG("ircstats: $_ => '$ircstats{$_}'."); + my $connectivity = 100 * ($total_time - $ircstats{'OffTime'}) / + $total_time; + my $p = sprintf("%.03f", $connectivity); + $p =~ s/(\.\d*)0+$/$1/; + if ($p =~ s/\.0$//) { + # this should not happen... but why... + } else { + $p =~ s/\.$// + } + + if ($total_time != (time() - $ircstats{'ConnectTime'}) ) { + my $tt_format = &Time2String($total_time); + &DEBUG("tt_format => $tt_format"); } ### RECONNECT COUNT. @@ -614,18 +655,19 @@ sub userCommands { } else { $reply = "Currently I'm hooked up to $ircstats{'Server'} but only". " for $format_time. ". - "I had to reconnect \002$count\002 times."; + "I had to reconnect \002$count\002 times.". + " Connectivity: $p %"; } ### REASON. my $reason = $ircstats{'DisconnectReason'}; if (defined $reason) { - $reply .= " I was last disconnected for '$reason'."; + $reply .= ". I was last disconnected for '$reason'."; } - &performStrictReply($reply); + &pSReply($reply); - return $noreply; + return; } # status. @@ -634,7 +676,7 @@ sub userCommands { my $upString = &Time2String(time() - $^T); my $count = &countKeys("factoids"); - &performStrictReply( + &pSReply( "Since $startString, there have been". " \002$count{'Update'}\002 ". &fixPlural("modification", $count{'Update'}). @@ -650,7 +692,7 @@ sub userCommands { "kB of memory." ); - return $noreply; + return; } # wantNick. xk++ @@ -659,15 +701,20 @@ sub userCommands { &msg($who, "I hope you're right. I'll try anyway."); } - my $str = "attempting to change nick to $param{'ircNick'}"; - &status($str); - &msg($who, $str); + if (! &IsNickInAnyChan( $param{ircNick} ) ) { + my $str = "attempting to change nick to $param{'ircNick'}"; + &status($str); + &msg($who, $str); + &nick($param{'ircNick'}); + } else { + &msg($who, "hrm... can't do it"); + &DEBUG("wN: nick is somewhere... should try later."); + } - &nick($param{'ircNick'}); - return $noreply; + return; } - # what else... + return "CONTINUE"; } 1;