X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=src%2FCommandStubs.pl;h=7da444ec790176150a434ec4afa892d43285a9a2;hb=f7cae48a17d6decd0a9bd997188271daa0a885b1;hp=7936155435befdac844ca57b8c793788877fa031;hpb=d7881f1eb07c9d88e1948aefc5ed835b6ef02201;p=infobot.git diff --git a/src/CommandStubs.pl b/src/CommandStubs.pl index 7936155..7da444e 100644 --- a/src/CommandStubs.pl +++ b/src/CommandStubs.pl @@ -1,53 +1,262 @@ # # User Command Extension Stubs +# WARN: this file does not reload on HUP. # -if (&IsParam("useStrict")) { use strict; } - -use vars qw(@W3Search_engines $W3Search_regex); -@W3Search_engines = qw(AltaVista Dejanews Excite Gopher HotBot Infoseek - Lycos Magellan PLweb SFgate Simple Verity Google); -$W3Search_regex = join '|', @W3Search_engines; -$babel::lang_regex = ""; # lame fix. - -### PROPOSED COMMAND HOOK IMPLEMENTATION. -# addCmdHook('TEXT_HOOK', $code_ref, -# (Forker => 1, -# Identifier => 'config_label', +# use strict; # TODO + +use vars qw($who $msgType $conn $chan $message $ident $talkchannel + $bot_version $babel_lang_regex $bot_data_dir); +use vars qw(@vernick @vernicktodo); +use vars qw(%channels %cache %mask %userstats %myModules %cmdstats + %hooks_extra %lang %ver); +# FIX THE FOLLOWING: +use vars qw($total $x $type $i $good); + +$babel_lang_regex = "fr|sp|es|po|pt|it|ge|de|gr|en|zh|ja|jp|ko|kr|ru"; +$w3search_regex = "google"; + +### COMMAND HOOK IMPLEMENTATION. +# addCmdHook("SECTION", 'TEXT_HOOK', +# (CODEREF => 'Blah', +# Forker => 1, +# CheckModule => 1, # ??? +# Module => 'blah.pl' # preload module. +# Identifier => 'config_label', # change to Config? # Help => 'help_label', # Cmdstats => 'text_label',) #} -### EXAMPLE -# addCmdHook('d?find', ( -# CODEREF => \&debianFind(), -# Forker => 1, -# Identifier => "debian", -# Help => "dfind", -# Cmdstats => "Debian Search",) ); -### NOTES: -# * viable solution? ### sub addCmdHook { - my ($ident, %hash) = @_; + my ($hashname, $ident, %hash) = @_; + + if (exists ${"hooks_$hashname"}{$ident}) { +### &WARN("aCH: cmd hooks \%$hashname{$ident} already exists."); + return; + } - &DEBUG("aCH: added $ident to command hooks."); - $cmdhooks{$ident} = \%hash; + &VERB("aCH: added $ident",2); # use $hash{'Identifier'}? + ### hrm... prevent warnings? + ${"hooks_$hashname"}{$ident} = \%hash; } # RUN IF ADDRESSED. sub parseCmdHook { - foreach (keys %cmdhooks) { - &DEBUG("cmdhooks{$_} => ..."); - my %hash = \%{ $cmdhooks{$_} }; + my ($hashname, $line) = @_; + $line =~ s/^\s+|\s+$//g; # again. + $line =~ /^(\S+)(\s+(.*))?$/; + my $cmd = $1; # command name is whitespaceless. + my $flatarg = $3; + my @args = split(/\s+/, $flatarg || ''); + my $done = 0; + + &shmFlush(); + + if (!defined %{"hooks_$hashname"}) { + &WARN("cmd hooks \%$hashname does not exist."); + return 0; + } + + if (!defined $cmd) { + &WARN("cstubs: cmd == NULL."); + return 0; + } + + foreach (keys %{"hooks_$hashname"}) { + # rename to something else! like $id or $label? + my $ident = $_; + + next unless ($cmd =~ /^$ident$/i); + + if ($done) { + &WARN("pCH: Multiple hook match: $ident"); + next; + } + + &status("hooks($hashname): $cmd matched '$ident' '$flatarg'"); + my %hash = %{ ${"hooks_$hashname"}{$ident} }; + + if (!scalar keys %hash) { + &WARN("CmdHook: hash is NULL?"); + return 1; + } + + if ($hash{NoArgs} and $flatarg) { + &DEBUG("cmd $ident does not take args ('$flatarg'); skipping."); + next; + } + + if (!exists $hash{CODEREF}) { + &ERROR("CODEREF undefined for $cmd or $ident."); + return 1; + } + + ### DEBUG. foreach (keys %hash) { - &DEBUG(" '$_' => '$hash{$_}'."); + &VERB(" $cmd->$_ => '$hash{$_}'.",2); } + + ### HELP. + if (exists $hash{'Help'} and !scalar(@args)) { + &help( $hash{'Help'} ); + return 1; + } + + ### IDENTIFIER. + if (exists $hash{'Identifier'}) { + return 1 unless (&hasParam($hash{'Identifier'})); + } + + ### USER FLAGS. + if (exists $hash{'UserFlag'}) { + return 1 unless (&hasFlag($hash{'UserFlag'})); + } + + ### FORKER,IDENTIFIER,CODEREF. + if (exists $hash{'Forker'}) { + $hash{'Identifier'} .= "-" if ($hash{'Forker'} eq "NULL"); + + if (exists $hash{'ArrayArgs'}) { + &Forker($hash{'Identifier'}, sub { \&{ $hash{'CODEREF'} }(@args) } ); + } else { + &Forker($hash{'Identifier'}, sub { \&{ $hash{'CODEREF'} }($flatarg) } ); + } + + } else { + if (exists $hash{'Module'}) { + &loadMyModule($myModules{ $hash{'Module'} }); + } + + # check if CODEREF exists. + if (!defined &{ $hash{'CODEREF'} }) { + &WARN("coderef $hash{'CODEREF'} does not exist."); + if (defined $who) { + &msg($who, "coderef does not exist for $ident."); + } + + return 1; + } + + if (exists $hash{'ArrayArgs'}) { + &{ $hash{'CODEREF'} }(@args); + } else { + &{ $hash{'CODEREF'} }($flatarg); + } + } + + ### CMDSTATS. + if (exists $hash{'Cmdstats'}) { + $cmdstats{ $hash{'Cmdstats'} }++; + } + + &VERB("hooks: End of command.",2); + + $done = 1; } - &DEBUG("pCH: ended."); + return 1 if ($done); + return 0; } +### +### START ADDING HOOKS. +### +&addCmdHook("extra", 'd?bugs', ('CODEREF' => 'DBugs::Parse', + 'Forker' => 1, 'Identifier' => 'debianExtra', + 'Cmdstats' => 'Debian Bugs') ); +&addCmdHook("extra", 'dauthor', ('CODEREF' => 'Debian::searchAuthor', + 'Forker' => 1, 'Identifier' => 'debian', + 'Cmdstats' => 'Debian Author Search', 'Help' => "dauthor" ) ); +&addCmdHook("extra", '(d|search)desc', ('CODEREF' => 'Debian::searchDescFE', + 'Forker' => 1, 'Identifier' => 'debian', + 'Cmdstats' => 'Debian Desc Search', 'Help' => "ddesc" ) ); +&addCmdHook("extra", 'dnew', ('CODEREF' => 'DebianNew', + 'Identifier' => 'debian' ) ); +&addCmdHook("extra", 'dincoming', ('CODEREF' => 'Debian::generateIncoming', + 'Forker' => 1, 'Identifier' => 'debian' ) ); +&addCmdHook("extra", 'dstats', ('CODEREF' => 'Debian::infoStats', + 'Forker' => 1, 'Identifier' => 'debian', + 'Cmdstats' => 'Debian Statistics' ) ); +&addCmdHook("extra", 'd?contents', ('CODEREF' => 'Debian::searchContents', + 'Forker' => 1, 'Identifier' => 'debian', + 'Cmdstats' => 'Debian Contents Search', 'Help' => "contents" ) ); +&addCmdHook("extra", 'd?find', ('CODEREF' => 'Debian::DebianFind', + 'Forker' => 1, 'Identifier' => 'debian', + 'Cmdstats' => 'Debian Search', 'Help' => "find" ) ); +#&addCmdHook("extra", 'insult', ('CODEREF' => 'Insult::Insult', +# 'Forker' => 1, 'Identifier' => 'insult', 'Help' => "insult" ) ); +&addCmdHook("extra", 'kernel', ('CODEREF' => 'Kernel::Kernel', + 'Forker' => 1, 'Identifier' => 'kernel', + 'Cmdstats' => 'Kernel', 'NoArgs' => 1) ); +&addCmdHook("extra", 'listauth', ('CODEREF' => 'CmdListAuth', + 'Identifier' => 'search', Module => 'factoids', + 'Help' => 'listauth') ); +&addCmdHook("extra", 'quote', ('CODEREF' => 'Quote::Quote', + 'Forker' => 1, 'Identifier' => 'quote', + 'Help' => 'quote', 'Cmdstats' => 'Quote') ); +&addCmdHook("extra", 'countdown', ('CODEREF' => 'Countdown', + 'Module' => 'countdown', 'Identifier' => 'countdown', + 'Cmdstats' => 'Countdown') ); +&addCmdHook("extra", 'lart', ('CODEREF' => 'lart', + 'Identifier' => 'lart', 'Help' => 'lart') ); +&addCmdHook("extra", 'convert', ('CODEREF' => 'convert', + 'Forker' => 1, 'Identifier' => 'units', + 'Help' => 'convert') ); +&addCmdHook("extra", '(cookie|random)', ('CODEREF' => 'cookie', + 'Forker' => 1, 'Identifier' => 'factoids') ); +&addCmdHook("extra", 'u(ser)?info', ('CODEREF' => 'userinfo', + 'Identifier' => 'userinfo', 'Help' => 'userinfo', + 'Module' => 'userinfo') ); +&addCmdHook("extra", 'rootWarn', ('CODEREF' => 'CmdrootWarn', + 'Identifier' => 'rootWarn', 'Module' => 'rootwarn') ); +&addCmdHook("extra", 'seen', ('CODEREF' => 'seen', 'Identifier' => + 'seen') ); +&addCmdHook("extra", 'dict', ('CODEREF' => 'Dict::Dict', + 'Identifier' => 'dict', 'Help' => 'dict', + 'Forker' => 1, 'Cmdstats' => 'Dict') ); +&addCmdHook("extra", 'slashdot', ('CODEREF' => 'Slashdot::Slashdot', + 'Identifier' => 'slashdot', 'Forker' => 1, + 'Cmdstats' => 'Slashdot') ); +&addCmdHook("extra", 'plug', ('CODEREF' => 'Plug::Plug', + 'Identifier' => 'plug', 'Forker' => 1, + 'Cmdstats' => 'Plug') ); +&addCmdHook("extra", 'uptime', ('CODEREF' => 'uptime', 'Identifier' => 'uptime', + 'Cmdstats' => 'Uptime') ); +&addCmdHook("extra", 'nullski', ('CODEREF' => 'nullski', ) ); +&addCmdHook("extra", 'verstats', ('CODEREF' => 'do_verstats' ) ); +&addCmdHook("extra", 'weather', ('CODEREF' => 'Weather::Weather', + 'Identifier' => 'weather', 'Help' => 'weather', + 'Cmdstats' => 'weather', 'Forker' => 1) ); +&addCmdHook("extra", 'bzflist', ('CODEREF' => 'BZFlag::list', + 'Identifier' => 'bzflag', 'Cmdstats' => 'BZFlag', + 'Forker' => 1) ); +&addCmdHook("extra", 'bzfquery', ('CODEREF' => 'BZFlag::query', + 'Identifier' => 'bzflag', 'Cmdstats' => 'BZFlag', + 'Forker' => 1, 'Help' => 'bzflag') ); +&addCmdHook("extra", 'zfi', ('CODEREF' => 'zfi::query', + 'Identifier' => 'zfi', 'Cmdstats' => 'zfi', + 'Forker' => 1) ); +&addCmdHook("extra", '(zippy|yow)', ('CODEREF' => 'zippy::get', + 'Identifier' => 'zippy', 'Cmdstats' => 'zippy', + 'Forker' => 1) ); +&addCmdHook("extra", 'zsi', ('CODEREF' => 'zsi::query', + 'Identifier' => 'zsi', 'Cmdstats' => 'zsi', + 'Forker' => 1) ); +&addCmdHook("extra", '(ex)?change', ('CODEREF' => 'Exchange::query', + 'Identifier' => 'exchange', 'Cmdstats' => 'exchange', + 'Forker' => 1) ); +&addCmdHook("extra", '(botmail|message)', ('CODEREF' => 'botmail::parse', + 'Identifier' => 'botmail', 'Cmdstats' => 'botmail') ); +&addCmdHook("extra", 'httpdtype', ('CODEREF' => 'HTTPDtype::HTTPDtype', + 'Identifier' => 'httpdtype', 'Cmdstats' => 'httpdtype', + 'Forker' => 1) ); + +### +### END OF ADDING HOOKS. +### +&status("CMD: loaded ".scalar(keys %hooks_extra)." EXTRA command hooks."); + sub Modules { if (!defined $message) { &WARN("Modules: message is undefined. should never happen."); @@ -55,610 +264,752 @@ sub Modules { } # babel bot: Jonathan Feinberg++ - if (&IsParam("babelfish") and $message =~ m{ + if ($message =~ m{ ^\s* (?:babel(?:fish)?|x|xlate|translate) \s+ - (to|from) # direction of translation (through) + ($babel_lang_regex)\w* # from language? \s+ - ($babel::lang_regex)\w* # which language? + ($babel_lang_regex)\w* # to language? \s* (.+) # The phrase to be translated - }xoi) { + }xoi) { + return unless (&hasParam("babelfish")); &Forker("babelfish", sub { &babel::babelfish(lc $1, lc $2, $3); } ); $cmdstats{'BabelFish'}++; - return $noreply; + return; } - # cookie (random). xk++ - if ($message =~ /^(cookie|random)(\s+(.*))?$/i) { - return $noreply unless (&hasParam("cookie")); - - my $arg = $3; + my $debiancmd = 'conflicts?|depends?|desc|file|(?:d)?info|provides?'; + $debiancmd .= '|recommends?|suggests?|maint|maintainer'; - # lets find that secret cookie. - my $target = $talkchannel; - $target = $who if ($msgType ne 'public'); + if ($message =~ /^($debiancmd)(\s+(.*))?$/i) { + return unless (&hasParam("debian")); + my $package = lc $3; - my $cookiemsg = &getRandom(keys %{$lang{'cookie'}}); - my ($key,$value); - ### WILL CHEW TONS OF MEM. - ### TODO: convert this to a Forker function! - if ($arg) { - my @list = &searchTable("factoids", "factoid_key", "factoid_value", $arg); - $key = &getRandom(@list); - $val = &getFactInfo("factoids", $key, "factoid_value"); + if (defined $package) { + &Forker("debian", sub { &Debian::infoPackages($1, $package); } ); } else { - ($key,$value) = &randKey("factoids","factoid_key,factoid_value"); + &help($1); } - $cookiemsg =~ s/##KEY/\002$key\002/; - $cookiemsg =~ s/##VALUE/$value/; - $cookiemsg =~ s/##WHO/$who/; - $cookiemsg =~ s/\$who/$who/; # cheap fix. - $cookiemsg =~ s/(\S+)?\s*<\S+>/$1 /; - $cookiemsg =~ s/\s+/ /g; + return; + } - if ($cookiemsg =~ s/^ACTION //i) { - &action($target, $cookiemsg); - } else { - &msg($target, $cookiemsg); - } + # google searching. Simon++ + if ($message =~ /^(?:search\s+)?($w3search_regex)\s+(?:for\s+)?['"]?(.*?)["']?\s*\?*$/i) { + return unless (&hasParam("wwwsearch")); - $cmdstats{'Random Cookie'}++; - return $noreply; + &Forker("wwwsearch", sub { &W3Search::W3Search($1,$2); } ); + + $cmdstats{'WWWSearch'}++; + return; } - if ($message =~ /^d?bugs$/i) { - return $noreply unless (&hasParam("debianExtra")); + # text counters. (eg: hehstats) + my $itc; + $itc = &getChanConf("ircTextCounters"); + $itc = &findChanConf("ircTextCounters") unless ($itc); + return if ($itc && &do_text_counters($itc) == 1); + # end of text counters. - &Forker("debianExtra", sub { &debianBugs(); } ); + # list{keys|values}. xk++. Idea taken from #linuxwarez@EFNET + if ($message =~ /^list(\S+)(\s+(.*))?$/i) { + return unless (&hasParam("search")); - $cmdstats{'Debian Bugs'}++; - return $noreply; - } + my $thiscmd = lc $1; + my $args = $3 || ""; - # Debian Author Search. - if ($message =~ /^dauthor(\s+(.*))?$/i) { - return $noreply unless (&hasParam("debian")); + $thiscmd =~ s/^vals$/values/; + return if ($thiscmd ne "keys" && $thiscmd ne "values"); - my $query = $2; - if (!defined $query) { - &help("dauthor"); - return $noreply; + # Usage: + if (!defined $args or $args =~ /^\s*$/) { + &help("list". $thiscmd); + return; + } + + # suggested by asuffield and \broken. + if ($args =~ /^["']/ and $args =~ /["']$/) { + &DEBUG("list*: removed quotes."); + $args =~ s/^["']|["']$//g; + } + + if (length $args < 2 && &IsFlag("o") ne "o") { + &msg($who, "search string is too short."); + return; } - &Forker("debian", sub { &Debian::searchAuthor($query); } ); + &Forker("search", sub { &Search::Search($thiscmd, $args); } ); - $cmdstats{'Debian Author Search'}++; - return $noreply; + $cmdstats{'Factoid Search'}++; + return; } - # Debian Incoming Search. - if ($message =~ /^dincoming$/i) { - return $noreply unless (&hasParam("debian")); + # Nickometer. Adam Spiers++ + if ($message =~ /^(?:lame|nick)ometer(?: for)? (\S+)/i) { + return unless (&hasParam("nickometer")); - &Forker("debian", sub { &Debian::generateIncoming(); } ); + my $term = (lc $1 eq 'me') ? $who : $1; - $cmdstats{'Debian Incoming Search'}++; - return $noreply; - } + &loadMyModule($myModules{'nickometer'}); - # Debian Distro(Package) Stats - if ($message =~ /^dstats(\s+(.*))?$/i) { - return $noreply unless (&hasParam("debian")); - my $dist = $2 || $Debian::defaultdist; + if ($term =~ /^$mask{chan}$/) { + &status("Doing nickometer for chan $term."); - &Forker("debian", sub { &Debian::infoStats($dist); } ); + if (!&validChan($term)) { + &msg($who, "error: channel is invalid."); + return; + } - $cmdstats{'Debian Statistics'}++; - return $noreply; - } + # step 1. + my %nickometer; + foreach (keys %{ $channels{lc $term}{''} }) { + my $str = $_; + if (!defined $str) { + &WARN("nickometer: nick in chan $term undefined?"); + next; + } + + my $value = &nickometer($str); + $nickometer{$value}{$str} = 1; + } + + # step 2. + ### TODO: compact with map? + my @list; + foreach (sort {$b <=> $a} keys %nickometer) { + my $str = join(", ", sort keys %{ $nickometer{$_} }); + push(@list, "$str ($_%)"); + } - # Debian Contents search. - if ($message =~ /^d?contents(\s+(.*))?$/i) { - return $noreply unless (&hasParam("debian")); + &pSReply( &formListReply(0, "Nickometer list for $term ", @list) ); + &DEBUG("test."); - my $query = $2; - if (!defined $query) { - &help("contents"); - return $noreply; + return; } - &Forker("debian", sub { &Debian::searchContents($query); } ); - - $cmdstats{'Debian Contents Search'}++; - return $noreply; - } + my $percentage = &nickometer($term); - # Debian Package info. - if ($message =~ /^d?find(\s+(.*))?$/i and &IsParam("debian")) { - my $string = $2; + if ($percentage =~ /NaN/) { + $percentage = "off the scale"; + } else { + $percentage = sprintf("%0.4f", $percentage); + $percentage =~ s/(\.\d+)0+$/$1/; + $percentage .= '%'; + } - if (!defined $string) { - &help("find"); - return $noreply; + if ($msgType eq 'public') { + &say("'$term' is $percentage lame, $who"); + } else { + &msg($who, "the 'lame nick-o-meter' reading for $term is $percentage, $who"); } - &Forker("debian", sub { &Debian::DebianFind($string); } ); - return $noreply; + return; } - if (&IsParam("debian")) { - my $debiancmd = 'conflicts?|depends?|desc|file|info|provides?'; - $debiancmd .= '|recommends?|suggests?|maint|maintainer'; - if ($message =~ /^($debiancmd)(\s+(.*))?$/i) { - my $package = lc $3; + # Topic management. xk++ + # may want to add a userflags for topic. -xk + if ($message =~ /^topic(\s+(.*))?$/i) { + return unless (&hasParam("topic")); - if (defined $package) { - &Forker("debian", sub { &Debian::infoPackages($1, $package); } ); - } else { - &help($1); - } + my $chan = $talkchannel; + my @args = split / /, $2 || ""; - return $noreply; + if (!scalar @args) { + &msg($who,"Try 'help topic'"); + return; } - } - # Dict. xk++ - if ($message =~ /^dict(\s+(.*))?$/i) { - return $noreply unless (&hasParam("dict")); + $chan = lc(shift @args) if ($msgType eq 'private'); + my $thiscmd = shift @args; - my $query = $2; - $query =~ s/^[\s\t]+//; - $query =~ s/[\s\t]+$//; - $query =~ s/[\s\t]+/ /; + # topic over public: + if ($msgType eq 'public' && $thiscmd =~ /^#/) { + &msg($who, "error: channel argument is not required."); + &msg($who, "\002Usage\002: topic "); + return; + } - if (!defined $query) { - &help("dict"); - return $noreply; + # topic over private: + if ($msgType eq 'private' && $chan !~ /^#/) { + &msg($who, "error: channel argument is required."); + &msg($who, "\002Usage\002: topic #channel "); + return; } - if (length $query > 30) { - &msg($who,"dictionary word is too long."); - return $noreply; + if (&validChan($chan) == 0) { + &msg($who,"error: invalid channel \002$chan\002"); + return; } - &Forker("dict", sub { &Dict::Dict($query); } ); + # for semi-outsiders. + if (!&IsNickInChan($who,$chan)) { + &msg($who, "Failed. You ($who) are not in $chan, hey?"); + return; + } - $cmdstats{'Dict'}++; - return $noreply; + # now lets do it. + &loadMyModule($myModules{'topic'}); + &Topic($chan, $thiscmd, join(' ', @args)); + $cmdstats{'Topic'}++; + return; } - # Freshmeat. xk++ - if ($message =~ /^(fm|freshmeat)(\s+(.*))?$/i) { - return $noreply unless (&hasParam("freshmeat")); - - my $query = $3; + # wingate. + if ($message =~ /^wingate$/i) { + return unless (&hasParam("wingate")); - if (!defined $query) { - &help("freshmeat"); - &msg($who, "I have \002".&countKeys("freshmeat")."\002 entries."); - return $noreply; + my $reply = "Wingate statistics: scanned \002" + .scalar(keys %wingate)."\002 hosts"; + my $queue = scalar(keys %wingateToDo); + if ($queue) { + $reply .= ". I have \002$queue\002 hosts in the queue"; + $reply .= ". Started the scan ".&Time2String(time() - $wingaterun)." ago"; } - &loadMyModule($myModules{'freshmeat'}); - &Freshmeat::Freshmeat($query); + &pSReply("$reply."); - $cmdstats{'Freshmeat'}++; - return $noreply; + return; } - # google searching. Simon++ - if (&IsParam("wwwsearch") and $message =~ /^(?:search\s+)?($W3Search_regex)\s+for\s+['"]?(.*?)['"]?\s*\?*$/i) { - return $noreply unless (&hasParam("wwwsearch")); + # do nothing and let the other routines have a go + return "CONTINUE"; +} - &Forker("wwwsearch", sub { &W3Search::W3Search($1,$2,$param{'wwwsearch'}); } ); +# Uptime. xk++ +sub uptime { + my $count = 1; + &msg($who, "- Uptime for $ident -"); + &msg($who, "Now: ". &Time2String(&uptimeNow()) ." running $bot_version"); - $cmdstats{'WWWSearch'}++; - return $noreply; + foreach (&uptimeGetInfo()) { + /^(\d+)\.\d+ (.*)/; + my $time = &Time2String($1); + my $info = $2; + + &msg($who, "$count: $time $2"); + $count++; } +} - # insult server. patch thanks to michael@limit.org - if ($message =~ /^insult(\s+(\S+))?$/) { - return $noreply unless (&hasParam("insult")); +# seen. +sub seen { + my($person) = lc shift; + $person =~ s/\?*$//; - my $person = $2; - if (!defined $person) { - &help("insult"); - return $noreply; - } + if (!defined $person or $person =~ /^$/) { + &help("seen"); - &Forker("insult", sub { &Insult::Insult($person); } ); + my $i = &countKeys("seen"); + &msg($who,"there ". &fixPlural("is",$i) ." \002$i\002 ". + "seen ". &fixPlural("entry",$i) ." that I know of."); - return $noreply; + return; } - # Kernel. xk++ - if ($message =~ /^kernel$/i) { - return $noreply unless (&hasParam("kernel")); + my @seen; - &Forker("kernel", sub { &Kernel::Kernel(); } ); + &seenFlush(); # very evil hack. oh well, better safe than sorry. - $cmdstats{'Kernel'}++; - return $noreply; + # TODO: convert to &sqlSelectRowHash(); + my $select = "nick,time,channel,host,message"; + if ($person eq "random") { + @seen = &randKey("seen", $select); + } else { + @seen = &sqlSelect("seen", $select, { nick => $person } ); } - # LART. originally by larne/cerb. - if ($message =~ /^lart(\s+(.*))?$/i) { - return $noreply unless (&hasParam("lart")); - my ($target) = &fixString($2); - - if (!defined $target) { - &help("lart"); - return $noreply; - } - my $extra = 0; - - my $chan = $talkchannel; - if ($msgType eq 'private') { - if ($target =~ /^($mask{chan})\s+(.*)$/) { - $chan = $1; - $target = $2; - $extra = 1; - } else { - &msg($who, "error: invalid format or missing arguments."); - &help("lart"); - return $noreply; - } - } - - my $line = &getRandomLineFromFile($bot_misc_dir. "/blootbot.lart"); - if (defined $line) { - if ($target =~ /^(me|you|itself|\Q$ident\E)$/i) { - $line =~ s/WHO/$who/g; - } else { - $line =~ s/WHO/$target/g; - } - $line .= ", courtesy of $who" if ($extra); - - &action($chan, $line); - } else { - &status("lart: error reading file?"); + if (scalar @seen < 2) { + foreach (@seen) { + &DEBUG("seen: _ => '$_'."); } + &performReply("i haven't seen '$person'"); + return; + } - return $noreply; + # valid seen. + my $reply; + ### TODO: multi channel support. may require &IsNick() to return + ### all channels or something. + + my @chans = &getNickInChans($seen[0]); + if (scalar @chans) { + $reply = "$seen[0] is currently on"; + + foreach (@chans) { + $reply .= " ".$_; + next unless (exists $userstats{lc $seen[0]}{'Join'}); + $reply .= " (".&Time2String(time() - $userstats{lc $seen[0]}{'Join'}).")"; + } + + if (&IsChanConf("seenStats") > 0) { + my $i; + $i = $userstats{lc $seen[0]}{'Count'}; + $reply .= ". Has said a total of \002$i\002 messages" if (defined $i); + $i = $userstats{lc $seen[0]}{'Time'}; + $reply .= ". Is idling for ".&Time2String(time() - $i) if (defined $i); + } + } else { + my $howlong = &Time2String(time() - $seen[1]); + $reply = "$seen[0] <$seen[3]> was last seen on IRC ". + "in channel $seen[2], $howlong ago, ". + "saying\002:\002 '$seen[4]'."; } - # Search factoid extensions by 'author'. xk++ - if ($message =~ /^listauth(\s+(\S+))?$/i) { - return $noreply unless (&hasParam("search")); + &pSReply($reply); + return; +} + +# User Information Services. requested by Flugh. +sub userinfo { + my ($arg) = join(' ',@_); - my $query = $2; + if ($arg =~ /^set(\s+(.*))?$/i) { + $arg = $2; + if (!defined $arg) { + &help("userinfo set"); + return; + } - if (!defined $query) { - &help("listauth"); - return $noreply; + &UserInfoSet(split /\s+/, $arg, 2); + } elsif ($arg =~ /^unset(\s+(.*))?$/i) { + $arg = $2; + if (!defined $arg) { + &help("userinfo unset"); + return; } - &loadMyModule($myModules{'factoids'}); - &performStrictReply( &CmdListAuth($query) ); - return $noreply; + &UserInfoSet($arg, ""); + } else { + &UserInfoGet($arg); } +} - # list{keys|values}. xk++. Idea taken from #linuxwarez@EFNET - if ($message =~ /^list(\S+)( (.*))?$/i) { - return $noreply unless (&hasParam("search")); - - my $thiscmd = lc($1); - my $args = $3; +# cookie (random). xk++ +sub cookie { + my ($arg) = @_; + + # lets find that secret cookie. + my $target = ($msgType ne 'public') ? $who : $talkchannel; + my $cookiemsg = &getRandom(keys %{ $lang{'cookie'} }); + my ($key,$value); + + ### WILL CHEW TONS OF MEM. + ### TODO: convert this to a Forker function! + if ($arg) { + my @list = &searchTable("factoids", "factoid_key", "factoid_value", $arg); + $key = &getRandom(@list); + $value = &getFactInfo($key, "factoid_value"); + } else { + ($key,$value) = &randKey("factoids","factoid_key,factoid_value"); + } - $thiscmd =~ s/^vals$/values/; - return $noreply if ($thiscmd ne "keys" && $thiscmd ne "values"); + for ($cookiemsg) { + s/##KEY/\002$key\002/; + s/##VALUE/$value/; + s/##WHO/$who/; + s/\$who/$who/; # cheap fix. + s/(\S+)?\s*<\S+>/$1 /; + s/\s+/ /g; + } - # Usage: - if (!defined $args) { - &help("list". $thiscmd); - return $noreply; - } + if ($cookiemsg =~ s/^ACTION //i) { + &action($target, $cookiemsg); + } else { + &msg($target, $cookiemsg); + } +} - if (length $args == 1) { - &msg($who,"search string is too short."); - return $noreply; - } +sub convert { + my $arg = join(' ',@_); + my ($from,$to) = ('',''); - ### chews up to 4megs => use forker :) - &Forker("search", sub { &Search::Search($thiscmd, $args); } ); -# &loadMyModule($myModules{'search'}); -# &Search::Search($thiscmd, $args); + ($from,$to) = ($1,$2) if ($arg =~ /^(.*?) to (.*)$/i); + ($from,$to) = ($2,$1) if ($arg =~ /^(.*?) from (.*)$/i); - $cmdstats{'Factoid Search'}++; - return $noreply; + if (!$to or !$from) { + &msg($who, "Invalid format!"); + &help("convert"); + return; } - # Nickometer. Adam Spiers++ - if ($message =~ /^(?:lame|nick)ometer(?: for)? (\S+)/i) { - return $noreply unless (&hasParam("nickometer")); + &Units::convertUnits($from, $to); - my $term = (lc $1 eq 'me') ? $who : $1; - $term =~ s/\?+\s*//; + return; +} - &loadMyModule($myModules{'nickometer'}); - my $percentage = &nickometer($term); +sub lart { + my ($target) = &fixString($_[0]); + my $extra = 0; + my $chan = $talkchannel; - if ($percentage =~ /NaN/) { - $percentage = "off the scale"; + if ($msgType eq 'private') { + if ($target =~ /^($mask{chan})\s+(.*)$/) { + $chan = $1; + $target = $2; + $extra = 1; } else { - $percentage = sprintf("%0.4f", $percentage); - $percentage =~ s/\.?0+$//; - $percentage .= '%'; + &msg($who, "error: invalid format or missing arguments."); + &help("lart"); + return; } + } - if ($msgType eq 'public') { - &say("'$term' is $percentage lame, $who"); + my $line = &getRandomLineFromFile($bot_data_dir. "/blootbot.lart"); + if (defined $line) { + if ($target =~ /^(me|you|itself|\Q$ident\E)$/i) { + $line =~ s/WHO/$who/g; } else { - &msg($who, "the 'lame nick-o-meter' reading for $term is $percentage, $who"); + $line =~ s/WHO/$target/g; } + $line .= ", courtesy of $who" if ($extra); - return $noreply; + &action($chan, $line); + } else { + &status("lart: error reading file?"); } +} - # Quotes. mu++ - if ($message =~ /^quote(\s+(\S+))?$/i) { - return $noreply unless (&hasParam("quote")); +sub DebianNew { + my $idx = "debian/Packages-sid.idx"; + my $error = 0; + my %pkg; + my @new; - my $query = $2; + $error++ unless ( -e $idx); + $error++ unless ( -e "$idx-old"); - if ($query eq "") { - &help("quote"); - return $noreply; - } + if ($error) { + $error = "no sid/sid-old index file found."; + &ERROR("Debian: $error"); + &msg($who, $error); + return; + } + + open(IDX1, $idx); + open(IDX2, "$idx-old"); - &Forker("quote", sub { &Quote::Quote($query); } ); + while () { + chop; + next if (/^\*/); - $cmdstats{'Quote'}++; - return $noreply; + $pkg{$_} = 1; } + close IDX2; - # rootWarn. xk++ - if ($message =~ /^rootWarn$/i) { - return $noreply unless (&hasParam("rootWarn")); + open(IDX1,$idx); + while () { + chop; + next if (/^\*/); + next if (exists $pkg{$_}); - &loadMyModule($myModules{'rootwarn'}); - &performStrictReply( &CmdrootWarn() ); - return $noreply; + push(@new, $_); } + close IDX1; - # seen. - if ($message =~ /^seen(\s+(\S+))?$/) { - return $noreply unless (&hasParam("seen")); - - my $person = $2; - if (!defined $person) { - &help("seen"); + &::pSReply( &::formListReply(0, "New debian packages:", @new) ); +} - my $i = &countKeys("seen"); - &msg($who,"there ". &fixPlural("is",$i) ." \002$i\002 ". - "seen ". &fixPlural("entry",$i) ." that I know of."); +sub do_verstats { + my ($chan) = @_; - return $noreply; - } + if (!defined $chan) { + &help("verstats"); + return; + } - my @seen; - $person =~ s/\?*$//; + if (!&validChan($chan)) { + &msg($who, "chan $chan is invalid."); + return; + } - &seenFlush(); # very evil hack. oh well, better safe than sorry. + if (scalar @vernick > scalar(keys %{ $channels{lc $chan}{''} })/4) { + &msg($who, "verstats already in progress for someone else."); + return; + } - ### TODO: Support &dbGetRowInfo(); like in &FactInfo(); - my $select = "nick,time,channel,host,message"; - if ($person eq "random") { - @seen = &randKey("seen", $select); - } else { - @seen = &dbGet("seen", "nick", $person, $select); - } + &msg($who, "Sending CTCP VERSION to $chan; results in 60s."); + $conn->ctcp("VERSION", $chan); + $cache{verstats}{chan} = $chan; + $cache{verstats}{who} = $who; + $cache{verstats}{msgType} = $msgType; - if (scalar @seen < 2) { - foreach (@seen) { - &DEBUG("seen: _ => '$_'."); - } - &performReply("i haven't seen '$person'"); - return $noreply; - } - - # valid seen. - my $reply; - ### TODO: multi channel support. may require &IsNick() to return - ### all channels or something. - my @chans = &GetNickInChans($seen[0]); - if (scalar @chans) { - $reply = "$seen[0] is currently on"; - - foreach (@chans) { - $reply .= " ".$_; - next unless (exists $userstats{lc $seen[0]}{'Join'}); - $reply .= " (".&Time2String(time() - $userstats{lc $seen[0]}{'Join'}).")"; - } + $conn->schedule(30, sub { + my $c = lc $cache{verstats}{chan}; + @vernicktodo = (); - if (&IsParam("seenStats")) { - my $i; - $i = $userstats{lc $seen[0]}{'Count'}; - $reply .= ". Has said a total of \002$i\002 messages" if (defined $i); - $i = $userstats{lc $seen[0]}{'Time'}; - $reply .= ". Is idling for ".&Time2String(time() - $i) if (defined $i); - } - } else { - my $howlong = &Time2String(time() - $seen[1]); - $reply = "$seen[0] <$seen[3]> was last seen on IRC ". - "in channel $seen[2], $howlong ago, ". - "saying\002:\002 '$seen[4]'."; + foreach (keys %{ $channels{$c}{''} } ) { + next if (grep /^\Q$_\E$/i, @vernick); + push(@vernicktodo, $_); } - &performStrictReply($reply); - return $noreply; - } + &verstats_flush(); + } ); - # slashdot headlines: from Chris Tessone. - if ($message =~ /^slashdot$/i) { - return $noreply unless (&hasParam("slashdot")); + $conn->schedule(60, sub { + my $vtotal = 0; + my $c = lc $cache{verstats}{chan}; + my $total = keys %{ $channels{$c}{''} }; + $chan = $c; + $who = $cache{verstats}{who}; + $msgType = $cache{verstats}{msgType}; + delete $cache{verstats}; # sufficient? - &Forker("slashdot", sub { &Slashdot::Slashdot() }); + foreach (keys %ver) { + $vtotal += scalar keys %{ $ver{$_} }; + } - $cmdstats{'Slashdot'}++; - return $noreply; - } + my %sorted; + my $unknown = $total - $vtotal; + my $perc = sprintf("%.1f", $unknown * 100 / $total); + $perc =~ s/.0$//; + $sorted{$perc}{"unknown/cloak"} = "$unknown ($perc%)" if ($unknown); - # Topic management. xk++ - # may want to add a flag(??) for topic in the near future. -xk - if ($message =~ /^topic(\s+(.*))?$/i) { - return $noreply unless (&hasParam("topic")); + foreach (keys %ver) { + my $count = scalar keys %{ $ver{$_} }; + $perc = sprintf("%.01f", $count * 100 / $total); + $perc =~ s/.0$//; # lame compression. - my $chan = $talkchannel; - my @args = split(/ /, $2); - - if (!scalar @args) { - &msg($who,"Try 'help topic'"); - return $noreply; + $sorted{$perc}{$_} = "$count ($perc%)"; } - $chan = lc(shift @args) if ($msgType eq 'private'); - my $thiscmd = shift @args; - - # topic over public: - if ($msgType eq 'public' && $thiscmd =~ /^#/) { - &msg($who, "error: channel argument is not required."); - &msg($who, "\002Usage\002: topic "); - return $noreply; + ### can be compressed to a map? + my @list; + foreach ( sort { $b <=> $a } keys %sorted ) { + my $perc = $_; + foreach (sort keys %{ $sorted{$perc} }) { + push(@list, "$_ - $sorted{$perc}{$_}"); + } } - # topic over private: - if ($msgType eq 'private' && $chan !~ /^#/) { - &msg($who, "error: channel argument is required."); - &msg($who, "\002Usage\002: topic #channel "); - return $noreply; - } + # hack. this is one major downside to scheduling. + $chan = $c; + &pSReply( &formListReply(0, "IRC Client versions for $c ", @list) ); - if (&validChan($chan) == 0) { - &msg($who,"error: invalid channel \002$chan\002"); - return $noreply; - } + # clean up not-needed data structures. + undef %ver; + undef @vernick; + } ); - # for semi-outsiders. - if (!&IsNickInChan($who,$chan)) { - &msg($who, "Failed. You ($who) are not in $chan, hey?"); - return $noreply; - } + return; +} - # now lets do it. - &loadMyModule($myModules{'topic'}); - &Topic($chan, $thiscmd, join(' ', @args)); - $cmdstats{'Topic'}++; - return $noreply; - } +sub verstats_flush { + for (1..5) { + last unless (scalar @vernicktodo); - # Countdown. - if ($message =~ /^countdown(\s+(\S+))?$/i) { - return $noreply unless (&hasParam("countdown")); + my $n = shift(@vernicktodo); + $conn->ctcp("VERSION", $n); + } - my $query = $2; + return unless (scalar @vernicktodo); - &loadMyModule($myModules{'countdown'}); - &Countdown($query); + $conn->schedule(3, \&verstats_flush() ); +} - $cmdstats{'Countdown'}++; +sub do_text_counters { + my ($itc) = @_; + $itc =~ s/([^\w\s])/\\$1/g; + my $z = join '|', split ' ', $itc; - return $noreply; + if ($msgType eq "privmsg" and $message =~ / ($mask{chan})$/) { + &DEBUG("ircTC: privmsg detected; chan = $1"); + $chan = $1; } - # User Information Services. requested by Flugh. - if ($message =~ /^u(ser)?info(\s+(.*))?$/i) { - return $noreply unless (&hasParam("userinfo")); - &loadMyModule($myModules{'userinfo'}); + if ($message =~ /^_stats(\s+(\S+))$/i) { + &textstats_main($2); + return 1; + } - my $arg = $3; - if (!defined $arg or $arg eq "") { - &help("userinfo"); - return $noreply; - } + my ($type,$arg); + if ($message =~ /^($z)stats(\s+(\S+))?$/i) { + $type = $1; + $arg = $3; + } else { + return 0; + } - if ($arg =~ /^set(\s+(.*))?$/i) { - $arg = $2; - if (!defined $arg) { - &help("userinfo set"); - return $noreply; - } + # even more uglier with channel/time arguments. + my $c = $chan; +# my $c = $chan || "PRIVATE"; + my $where = "type=".&sqlQuote($type); + if (defined $c) { + &DEBUG("c => $c"); + $where .= " AND channel=".&sqlQuote($c) if (defined $c); + } else { + &DEBUG("not using chan arg"); + } - &UserInfoSet(split /\s+/, $arg, 2); - } elsif ($arg =~ /^unset(\s+(.*))?$/i) { - $arg = $2; - if (!defined $arg) { - &help("userinfo unset"); - return $noreply; + my $sum = (&sqlRawReturn("SELECT SUM(counter) FROM stats" + ." WHERE ".$where ))[0]; + + if (!defined $arg or $arg =~ /^\s*$/) { + # this is way fucking ugly. + + # TODO convert $where to hash + my %hash = &sqlSelectColHash("stats", "nick,counter", + { }, + $where." ORDER BY counter DESC LIMIT 3", 1 + ); + my $i; + my @top; + + # unfortunately we have to sort it again! + my $tp = 0; + foreach $i (sort { $b <=> $a } keys %hash) { + foreach (keys %{ $hash{$i} }) { + my $p = sprintf("%.01f", 100*$i/$sum); + $tp += $p; + push(@top, "\002$_\002 -- $i ($p%)"); } + } + my $topstr = ""; + if (scalar @top) { + $topstr = ". Top ".scalar(@top).": ".join(', ', @top); + } - &UserInfoSet($arg, ""); + if (defined $sum) { + &pSReply("total count of \037$type\037 on \002$c\002: $sum$topstr"); } else { - &UserInfoGet($arg); + &pSReply("zero counter for \037$type\037."); } + } else { + # TODO convert $where to hash and use a sqlSelect + my $x = (&sqlRawReturn("SELECT SUM(counter) FROM stats". + " WHERE $where AND nick=".&sqlQuote($arg) ))[0]; - $cmdstats{'UIS'}++; - return $noreply; - } - - # Uptime. xk++ - if ($message =~ /^uptime$/i) { - return $noreply unless (&hasParam("uptime")); + if (!defined $x) { # !defined. + &pSReply("$arg has not said $type yet."); + return 1; + } - my $count = 1; - &msg($who, "- Uptime for $ident -"); - &msg($who, "Now: ". &Time2String(&uptimeNow()) ." running $bot_version"); - foreach (&uptimeGetInfo()) { - /^(\d+)\.\d+ (.*)/; - my $time = &Time2String($1); - my $info = $2; + # defined. + # TODO convert $where to hash + my @array = &sqlSelect("stats", "nick", undef, + $where." ORDER BY counter", 1 + ); + my $good = 0; + my $i = 0; + for ($i=0; $i $c } : ""; + my $sum = &sqlSelect("stats", "SUM(counter)", $where_href); + + if (!defined $arg or $arg =~ /^\s*$/) { + # this is way fucking ugly. + &DEBUG("_stats: !arg"); + + my %hash = &sqlSelectColHash("stats", "nick,counter", + $where_href, + " ORDER BY counter DESC LIMIT 3", 1 + ); + my $i; + my @top; + + # unfortunately we have to sort it again! + my $tp = 0; + foreach $i (sort { $b <=> $a } keys %hash) { + foreach (keys %{ $hash{$i} }) { + my $p = sprintf("%.01f", 100*$i/$sum); + $tp += $p; + push(@top, "\002$_\002 -- $i ($p%)"); + } } - &performStrictReply("$reply."); + my $topstr = ""; + if (scalar @top) { + $topstr = ". Top ".scalar(@top).": ".join(', ', @top); + } - return $noreply; - } + if (defined $sum) { + &pSReply("total count of \037$type\037 on \002$c\002: $sum$topstr"); + } else { + &pSReply("zero counter for \037$type\037."); + } - # convert. - if ($message =~ /^convert(\s+(.*))?$/i) { - return $noreply unless (&hasParam("units")); + return; + } - my $str = $2; - if (!defined $str) { - &help("convert"); - return $noreply; - } + # TODO add nick to where_href + my %hash = &sqlSelectColHash("stats", "type,counter", + $where_href, " AND nick=".&sqlQuote($arg) + ); + # this is totally fucked... needs to be fixed... and cleaned up. + my $total; + my $good; + my $ii; + my $x; + + foreach (keys %hash) { + &DEBUG("_stats: hash{$_} => $hash{$_}"); + # ranking. + # TODO convert $where to hash + my @array = &sqlSelect("stats", "nick", undef, + $where." ORDER BY counter", 1); + $good = 0; + $ii = 0; + for(my $i=0; $i $i, good => $good, total => $total"); + $x .= " ".$total."blah blah"; + } - my ($from,$to); - ($from,$to) = ($1,$2) if ($str =~ /^(.*) to (.*)$/); - ($from,$to) = ($2,$1) if ($str =~ /^(.*) from (.*)$/); - if (!defined $from or !defined $to or $to eq "" or $from eq "") { - &msg($who, "Invalid format!"); - &help("convert"); - return $noreply; - } +# return; - &Forker("units", sub { &Units::convertUnits($from, $to); } ); + if (!defined $x) { # !defined. + &pSReply("$arg has not said $type yet."); + return; + } - return $noreply; + my $xtra = ""; + if ($total and $good) { + my $pct = sprintf("%.01f", 100*(1+$total-$ii)/$total); + $xtra = ", ranked $ii\002/\002$total (percentile: \002$pct\002 %)"; } - # do nothing and let the other routines have a go - return ''; + my $pct1 = sprintf("%.01f", 100*$x/$sum); + &pSReply("\002$arg\002 has said \037$type\037 \002$x\002 times (\002$pct1\002 %)$xtra"); } +sub nullski { my ($arg) = @_; return unless (defined $arg); + foreach (`$arg`) { &msg($who,$_); } } + 1;