X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=blootbot%2Fsrc%2FUserExtra.pl;h=f672f16cb4969f102cf67880918a47a97dcdafc0;hb=16c36ddd8e8e1f0c2e6add8e2ddc52005f5e7198;hp=11d6de24852b437f052cc44c49b8e086509de61d;hpb=d46550ad979348a8ca6885f10ba7bc488a4c1ec8;p=infobot.git diff --git a/blootbot/src/UserExtra.pl b/blootbot/src/UserExtra.pl index 11d6de2..f672f16 100644 --- a/blootbot/src/UserExtra.pl +++ b/blootbot/src/UserExtra.pl @@ -1,41 +1,15 @@ # # UserExtra.pl: User Commands, Public. # Author: dms -# Version: v0.2b (20000707) -# Created: 20000107 # use strict; use vars qw($message $arg $qWord $verb $lobotomized $who $result $chan $conn $msgType $query $talkchannel $ident $memusage); -use vars qw(%channels %chanstats %cmdstats %count %ircstats %param - %cache %mask %userstats %hooks_main); +use vars qw(%channels %chanstats %cmdstats %count %forked %ircstats %param + %cache %mask %userstats); -### -### Start of command hooks for UserExtra. -### - -&addCmdHook("main", 'chan(stats|info)', ('CODEREF' => 'chaninfo', ) ); -&addCmdHook("main", 'cmd(stats|info)', ('CODEREF' => 'cmdstats', ) ); -&addCmdHook("main", 'sched(stats|info)', ('CODEREF' => 'scheduleList', ) ); -&addCmdHook("main", 'factinfo', ('CODEREF' => 'factinfo', - 'Cmdstats' => 'Factoid Info', Module => 'Factoids', ) ); -&addCmdHook("main", 'factstats?', ('CODEREF' => 'factstats', - 'Cmdstats' => 'Factoid Stats', Help => "factstats", - Forker => 1, 'Identifier' => 'Factoids', ) ); -&addCmdHook("main", 'help', ('CODEREF' => 'help', - 'Cmdstats' => 'Help', ) ); -&addCmdHook("main", 'karma', ('CODEREF' => 'karma', ) ); -&addCmdHook("main", 'tell|explain', ('CODEREF' => 'tell', - Help => 'tell', Identifier => 'allowTelling', - Cmdstats => 'Tell') ); -&addCmdHook("main", 'News', ('CODEREF' => 'News::Parse', - Module => 'News', 'Cmdstats' => 'News' ) ); -&addCmdHook("main", 'countrystats', ('CODEREF' => 'countryStats', -# Forker => "NULL", - ) ); - -&status("CMD: loaded ".scalar(keys %hooks_main)." MAIN command hooks."); +### hooks get added in CommandHooks.pl. ### ### Start of commands for hooks. @@ -45,15 +19,16 @@ sub chaninfo { my $chan = lc shift(@_); my $mode; - if ($chan eq "") { # all channels. + if ($chan eq '') { # all channels. my $i = keys %channels; - my $reply = "i am on \002$i\002 ".&fixPlural("channel",$i); + my $reply = "I'm on \002$i\002 ".&fixPlural('channel',$i); my $tucount = 0; # total user count. my $uucount = 0; # unique user count. + my %chans; my @array; ### line 1. - foreach (sort keys %channels) { + foreach (keys %channels) { if ( /^\s*$/ or / / ) { &status("chanstats: fe channels: chan == NULL."); #&ircCheck(); @@ -61,11 +36,12 @@ sub chaninfo { } next if (/^_default$/); - my $str = sprintf("%s(%d)", $_, scalar(keys %{ $channels{$_}{''} })); - push(@array, $str); + $chans{$_} = scalar(keys %{ $channels{$_}{''} }); + } + foreach $chan (sort {$chans{$b} <=> $chans{$a}} keys %chans) { + push(@array, "$chan/" . $chans{$chan}); } &performStrictReply($reply.": ".join(', ', @array)); - &ircCheck(); ### total user count. foreach $chan (keys %channels) { @@ -73,28 +49,23 @@ sub chaninfo { } ### unique user count. - my @nicks; + my %nicks = (); foreach $chan (keys %channels) { - my $nick = ''; + my $nick; foreach $nick (keys %{ $channels{$chan}{''} }) { - next if (grep /^\Q$nick\E$/, @nicks); - $uucount++; - push(@nicks, $nick); + $nicks{$nick}++; } } - &::DEBUG(join ":", @nicks); - - if (scalar @nicks != $uucount) { - &DEBUG("nicks != uucount..."); - } + $uucount = scalar(keys %nicks); my $chans = scalar(keys %channels); &performStrictReply( - "i've cached \002$tucount\002 ". &fixPlural("user",$tucount). - ", \002$uucount\002 unique ". &fixPlural("user",$uucount). + "i've cached \002$tucount\002 ". &fixPlural('user',$tucount). + ", \002$uucount\002 unique ". &fixPlural('user',$uucount). ", distributed over \002$chans\002 ". - &fixPlural("channel", $chans)."." + &fixPlural('channel', $chans)."." ); + &ircCheck(); return; } @@ -115,7 +86,7 @@ sub chaninfo { push(@array, "\002$int\002 ". &fixPlural($_,$int)); } my $reply = "On \002$chan\002, there ". - &fixPlural("has",scalar(@array)). " been ". + &fixPlural('has',scalar(@array)). " been ". &IJoin(@array); # Step 1b: check channel inconstencies. @@ -139,13 +110,13 @@ sub chaninfo { # Step 2: undef @array; my $type; - foreach ("v","o","") { + foreach ('v','o','') { my $int = scalar(keys %{ $channels{$chan}{$_} }); next unless ($int); - $type = "Voice" if ($_ eq "v"); - $type = "Opped" if ($_ eq "o"); - $type = "Total" if ($_ eq ""); + $type = 'Voice' if ($_ eq 'v'); + $type = 'Opped' if ($_ eq 'o'); + $type = 'Total' if ($_ eq ''); push(@array,"\002$int\002 $type"); } @@ -199,7 +170,7 @@ sub cmdstats { # Factoid extension info. xk++ sub factinfo { my $faqtoid = lc shift(@_); - my $query = ""; + my $query = ''; if ($faqtoid =~ /^\-(\S+)(\s+(.*))$/) { &msg($who,"error: individual factoid info queries not supported as yet."); @@ -216,15 +187,15 @@ sub factinfo { sub factstats { my $type = shift(@_); - &Forker("factoids", sub { + &Forker('Factoids', sub { &performStrictReply( &CmdFactStats($type) ); } ); } sub karma { my $target = lc( shift || $who ); - my $karma = &sqlSelect("stats", "counter", - { nick => $target, type => "karma" }) || 0; + my $karma = &sqlSelect('stats', 'counter', + { nick => $target, type => 'karma'}) || 0; if ($karma != 0) { &performStrictReply("$target has karma of $karma"); @@ -281,7 +252,7 @@ sub tell { &status("tell: target = $target, query = $query"); - # "intrusive". + # 'intrusive'. # if ($target !~ /^$mask{chan}$/ and !&IsNickInAnyChan($target)) { # &msg($who, "No, $target is not in any of my chans."); # return; @@ -303,13 +274,12 @@ sub tell { # no such factoid. if (!defined $result || $result =~ /^0?$/) { $who = $target; - $msgType = "private"; + $msgType = 'private'; # support command redirection. # recursive cmdHooks aswell :) my $done = 0; - $done++ if &parseCmdHook("main", $tell_obj); - $done++ if &parseCmdHook("extra", $tell_obj); + $done++ if &parseCmdHook($tell_obj); $message = $tell_obj; $done++ unless (&Modules()); @@ -349,12 +319,12 @@ sub countryStats { return; } - if ($chan eq "") { + if ($chan eq '') { $chan = $_[0]; } - if ($chan eq "") { - &help("countrystats"); + if ($chan eq '') { + &help('countrystats'); return; } @@ -397,7 +367,7 @@ sub do_countrystats { } # TODO: move this into a scheduler - $msgType = "private"; + $msgType = 'private'; &performStrictReply( &formListReply(0, "Country Stats ", @list) ); delete $cache{countryStats}; @@ -412,13 +382,13 @@ sub userCommands { # conversion: ascii. if ($message =~ /^(asci*|chr) (\d+)$/) { &DEBUG("ascii/chr called ..."); - return unless (&IsChanConfOrWarn("allowConv")); + return unless (&IsChanConfOrWarn('allowConv')); &DEBUG("ascii/chr called"); $arg = $2; $result = chr($arg); - $result = "NULL" if ($arg == 0); + $result = 'NULL' if ($arg == 0); &performReply( sprintf("ascii %s is '%s'", $arg, $result) ); @@ -427,12 +397,12 @@ sub userCommands { # conversion: ord. if ($message =~ /^ord(\s+(.*))$/) { - return unless (&IsChanConfOrWarn("allowConv")); + return unless (&IsChanConfOrWarn('allowConv')); $arg = $2; if (!defined $arg or length $arg != 1) { - &help("ord"); + &help('ord'); return; } @@ -451,11 +421,11 @@ sub userCommands { # hex. if ($message =~ /^hex(\s+(.*))?$/i) { - return unless (&IsChanConfOrWarn("allowConv")); + return unless (&IsChanConfOrWarn('allowConv')); my $arg = $2; if (!defined $arg) { - &help("hex"); + &help('hex'); return; } @@ -475,40 +445,27 @@ sub userCommands { } # crypt. - if ($message =~ /^crypt(\s+(.*))?$/i) { - my @args = split /\s+/, $2; - - if (!scalar @args or scalar @args > 2) { - &help("crypt"); - return; - } - - if (scalar @args == 2) { -# disable cause $1$ will use md5 -# if (length $args[0] != 2) { -# &msg($who, "invalid format..."); -# return; -# } - - &performStrictReply( crypt($args[1], $args[0]) ); + if ($message =~ /^crypt\s+(\S*)?\s*(.*)?$/i) { +&status("crypt: $1:$2:$3"); + if ("$2" ne '') { + &performStrictReply(crypt($2, $1)); } else { - &performStrictReply( &mkcrypt($args[0]) ); + &performStrictReply(&mkcrypt($1)); } - return; } # cycle. if ($message =~ /^(cycle)(\s+(\S+))?$/i) { - return unless (&hasFlag("o")); + return unless (&hasFlag('o')); my $chan = lc $3; - if ($chan eq "") { + if ($chan eq '') { if ($msgType =~ /public/) { $chan = $talkchannel; &DEBUG("cycle: setting chan to '$chan'."); } else { - &help("cycle"); + &help('cycle'); return; } } @@ -520,7 +477,7 @@ sub userCommands { &msg($chan, "I'm coming back. (courtesy of $who)"); &part($chan); -### &ScheduleThis(5, "getNickInUse") if (@_); +### &ScheduleThis(5, 'getNickInUse') if (@_); &status("Schedule rejoin in 5secs to $chan by $who."); $conn->schedule(5, sub { &joinchan($chan); }); @@ -529,7 +486,7 @@ sub userCommands { # reload. if ($message =~ /^reload$/i) { - return unless (&hasFlag("n")); + return unless (&hasFlag('n')); &status("USER reload $who"); &performStrictReply("reloading..."); @@ -540,21 +497,21 @@ sub userCommands { # redir. if ($message =~ /^redir(\s+(.*))?/i) { - return unless (&hasFlag("o")); + return unless (&hasFlag('o')); my $factoid = $2; if (!defined $factoid) { - &help("redir"); + &help('redir'); return; } my $val = &getFactInfo($factoid, "factoid_value"); - if (!defined $val or $val eq "") { + if (!defined $val or $val eq '') { &msg($who, "error: '$factoid' does not exist."); return; } &DEBUG("val => '$val'."); - my @list = &searchTable("factoids", "factoid_key", + my @list = &searchTable('factoids', "factoid_key", "factoid_value", "^$val\$"); if (scalar @list == 1) { @@ -591,15 +548,20 @@ sub userCommands { } # rot13 it. - if ($message =~ /^rot13(\s+(.*))?/i) { - my $reply = $2; + if ($message =~ /^rot([0-9]*)(\s+(.*))?/i) { + my $reply = $3; if (!defined $reply) { - &help("rot13"); + &help('rot13'); return; } + my $num = $1 % 26; + my $upper='ABCDEFGHIJKLMNOPQRSTUVWXYZ'; + my $lower='abcdefghijklmnopqrstuvwxyz'; + my $to=substr($upper,$num).substr($upper,0,$num).substr($lower,$num).substr($lower,0,$num); + eval "\$reply =~ tr/$upper$lower/$to/;"; - $reply =~ y/A-Za-z/N-ZA-Mn-za-m/; + #$reply =~ y/A-Za-z/N-ZA-Mn-za-m/; &performStrictReply($reply); return; @@ -707,7 +669,7 @@ sub userCommands { my $startString = scalar(gmtime $^T); my $upString = &Time2String(time() - $^T); my ($puser,$psystem,$cuser,$csystem) = times; - my $factoids = &countKeys("factoids"); + my $factoids = &countKeys('factoids'); my $forks = 0; foreach (keys %forked) { $forks += scalar keys %{ $forked{$_} }; @@ -721,47 +683,30 @@ sub userCommands { &performStrictReply( "Since $startString, there have been". " \002$count{'Update'}\002 ". - &fixPlural("modification", $count{'Update'}). + &fixPlural('modification', $count{'Update'}). ", \002$count{'Question'}\002 ". - &fixPlural("question",$count{'Question'}). + &fixPlural('question',$count{'Question'}). ", \002$count{'Dunno'}\002 ". - &fixPlural("dunno",$count{'Dunno'}). + &fixPlural('dunno',$count{'Dunno'}). ", \002$count{'Moron'}\002 ". - &fixPlural("moron",$count{'Moron'}). + &fixPlural('moron',$count{'Moron'}). " and \002$count{'Commands'}\002 ". - &fixPlural("command",$count{'Commands'}). + &fixPlural('command',$count{'Commands'}). ". I have been awake for $upString this session, and ". "currently reference \002$factoids\002 factoids. ". "I'm using about \002$memusage\002 ". "kB of memory. With \002$forks\002 active ". - &fixPlural("fork",$forks). + &fixPlural('fork',$forks). ". Process time user/system $puser/$psystem child $cuser/$csystem" ); return; - - my %hash = &sqlSelectColHash("stats", "nick,counter", - { type => "cmdstats" }, 1); -# ORDER won't be retained in a hash -# " ORDER BY counter DESC", 1); - -if (0) { - foreach (keys %hash) { - my $i = $_; - foreach (keys %{ $hash{$i} }) { - &DEBUG("cmdstats: $hash{$i}{$_} = $_"); - } - } - &DEBUG("end of cmdstats."); -} - - return; } # wantNick. xk++ - # FIXME does not try to get nick "back", just switches nicks + # FIXME does not try to get nick 'back', just switches nicks if ($message =~ /^wantNick\s(.*)?$/i) { - return unless (&hasFlag("o")); + return unless (&hasFlag('o')); my $wantnick = lc $1; my $mynick = $conn->nick(); @@ -784,7 +729,7 @@ if (0) { my $str = "someone is using nick $wantnick; GHOSTing"; &status($str); &msg($who, $str); - &msg("NickServ", "GHOST $wantnick $param{'nickServ_pass'}"); + &msg('NickServ', "GHOST $wantnick $param{'nickServ_pass'}"); $conn->schedule(5, sub { &status("going to change nick from $mynick to $wantnick after GHOST."); @@ -797,7 +742,7 @@ if (0) { return; } - return "CONTINUE"; + return 'CONTINUE'; } 1;