X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=src%2FCommandStubs.pl;h=1a55669aef5b19ad323f1480aa82a45997506e3f;hb=c68ac9b2d4b88535c1a2cfa695f6c4f683f0373c;hp=a4c3679c315e2c49f88d9efe248a5f19c79d7a10;hpb=55f3301ffc29179747f2651ba2cdb5cff8fb5fb5;p=infobot.git

diff --git a/src/CommandStubs.pl b/src/CommandStubs.pl
index a4c3679..1a55669 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; }
@@ -47,7 +48,13 @@ sub parseCmdHook {
 	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);
@@ -66,7 +73,7 @@ sub parseCmdHook {
 	}
 
 	if ($hash{NoArgs} and $flatarg) {
-	    &DEBUG("cmd $ident does not take args; skipping.");
+	    &DEBUG("cmd $ident does not take args ('$flatarg'); skipping.");
 	    next;
 	}
 
@@ -101,9 +108,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 {
@@ -114,13 +121,17 @@ sub parseCmdHook {
 	    # check if CODEREF exists.
 	    if (!defined &{ $hash{'CODEREF'} }) {
 		&WARN("coderef $hash{'CODEREF'} don't exist.");
+		if (defined $who) {
+		    &msg($who, "coderef does not exist for $ident.");
+		}
+
 		return 1;
 	    }
 
 	    if (exists $hash{'ArrayArgs'}) {
-		&{$hash{'CODEREF'}}(@args);
+		&{ $hash{'CODEREF'} }(@args);
 	    } else {
-		&{$hash{'CODEREF'}}($flatarg);
+		&{ $hash{'CODEREF'} }($flatarg);
 	    }
 	}
 
@@ -141,7 +152,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',
@@ -217,7 +228,7 @@ sub Modules {
     }
 
     # babel bot: Jonathan Feinberg++
-    if (&IsChanConf("babelfish") and $message =~ m{
+    if ($message =~ m{
 		^\s*
 		(?:babel(?:fish)?|x|xlate|translate)
 		\s+
@@ -226,7 +237,8 @@ sub Modules {
 		($babel_lang_regex)\w*	# which language?
 		\s*
 		(.+)			# The phrase to be translated
-	}xoi) {
+    }xoi) {
+	return unless (&hasParam("babelfish"));
 
 	&Forker("babelfish", sub { &babel::babelfish(lc $1, lc $2, $3); } );
 
@@ -234,24 +246,24 @@ sub Modules {
 	return;
     }
 
-    if (&IsChanConf("debian")) {
-	my $debiancmd	 = 'conflicts?|depends?|desc|file|info|provides?';
-	$debiancmd	.= '|recommends?|suggests?|maint|maintainer';
-	if ($message =~ /^($debiancmd)(\s+(.*))?$/i) {
-	    my $package = lc $3;
+    my $debiancmd	 = 'conflicts?|depends?|desc|file|info|provides?';
+    $debiancmd		.= '|recommends?|suggests?|maint|maintainer';
 
-	    if (defined $package) {
-		&Forker("debian", sub { &Debian::infoPackages($1, $package); } );
-	    } else {
-		&help($1);
-	    }
+    if ($message =~ /^($debiancmd)(\s+(.*))?$/i) {
+	return unless (&hasParam("debian"));
+	my $package = lc $3;
 
-	    return;
+	if (defined $package) {
+	    &Forker("debian", sub { &Debian::infoPackages($1, $package); } );
+	} else {
+	    &help($1);
 	}
+
+	return;
     }
 
     # google searching. Simon++
-    if (&IsChanConf("wwwsearch") and $message =~ /^(?:search\s+)?(\S+)\s+for\s+['"]?(.*?)['"]?\s*\?*$/i) {
+    if ($message =~ /^(?:search\s+)?(\S+)\s+for\s+['"]?(.*?)["']?\s*\?*$/i) {
 	return unless (&hasParam("wwwsearch"));
 
 	&Forker("wwwsearch", sub { &W3Search::W3Search($1,$2); } );
@@ -260,28 +272,130 @@ sub Modules {
 	return;
     }
 
+    # text counters. (eg: hehstats)
+    my $itc;
+    $itc = &getChanConf("ircTextCounters");
+    $itc = &findChanConf("ircTextCounters") unless ($itc);
+    if ($itc) {
+	$itc =~ s/([^\w\s])/\\$1/g;
+	my $z = join '|', split ' ', $itc;
+
+	if ($msgType eq "privmsg" and $message =~ / ($mask{chan})$/) {
+	    &DEBUG("ircTC: privmsg detected; chan = $1");
+	    $chan = $1;
+	}
+
+	if ($message =~ /^_stats(\s+(\S+))$/i) {
+	    &textstats_main($2);
+	    return;
+	}
+
+	if ($message =~ /^($z)stats(\s+(\S+))?$/i) {
+	    my $type	= $1;
+	    my $arg	= $3;
+
+	    # even more uglier with channel/time arguments.
+	    my $c	= $chan;
+#	    my $c	= $chan || "PRIVATE";
+	    my $where	= "type=".&dbQuote($type);
+	    $where	.= " AND channel=".&dbQuote($c) if (defined $c);
+	    &DEBUG("not using chan arg") if (!defined $c);
+	    my $sum = (&dbRawReturn("SELECT SUM(counter) FROM stats"
+			." WHERE ".$where ))[0];
+
+	    if (!defined $arg or $arg =~ /^\s*$/) {
+		# this is way fucking ugly.
+
+		my %hash = &dbGetCol("stats", "nick,counter",
+			$where." ORDER BY counter DESC LIMIT 3", 1);
+		my $i;
+		my @top;
+
+		# unfortunately we have to sort it again!
+		# todo: make dbGetCol return hash and array? too much effort.
+		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 = "";
+		&DEBUG("*stats: tp => $tp");
+		if (scalar @top) {
+		    $topstr = ".  Top ".scalar(@top).": ".join(', ', @top);
+		}
+
+		if (defined $sum) {
+		    &pSReply("total count of \037$type\037 on \002$c\002: $sum$topstr");
+		} else {
+		    &pSReply("zero counter for \037$type\037.");
+		}
+	    } else {
+		my $x = (&dbRawReturn("SELECT SUM(counter) FROM stats".
+			" WHERE $where AND nick=".&dbQuote($arg) ))[0];
+
+		if (!defined $x) {	# !defined.
+		    &pSReply("$arg has not said $type yet.");
+		    return;
+		}
+
+		# defined.
+		my @array = &dbGet("stats", "nick",
+			$where." ORDER BY counter", 1);
+		my $good = 0;
+		my $i = 0;
+		for($i=0; $i<scalar @array; $i++) {
+		    next unless ($array[0] =~ /^\Q$who\E$/);
+		    $good++;
+		    last;
+		}
+		$i++;
+
+		my $total = scalar(@array);
+		my $xtra = "";
+		if ($total and $good) {
+		    my $pct = sprintf("%.01f", 100*(1+$total-$i)/$total);
+		    $xtra = ", ranked $i\002/\002$total (percentile: \002$pct\002 %)";
+		}
+
+		my $pct1 = sprintf("%.01f", 100*$x/$sum);
+		&pSReply("\002$arg\002 has said \037$type\037 \002$x\002 times (\002$pct1\002 %)$xtra");
+	    }
+
+	    return;
+	}
+
+	if ($@) {
+	    &DEBUG("regex failed: $@");
+	    return;
+	}
+    }
+
     # list{keys|values}. xk++. Idea taken from #linuxwarez@EFNET
-    if ($message =~ /^list(\S+)( (.*))?$/i) {
+    if ($message =~ /^list(\S+)(\s+(.*))?$/i) {
 	return unless (&hasParam("search"));
 
-	my $thiscmd	= lc($1);
-	my $args	= $3;
-	$args		=~ s/\s+$//g;
-	# suggested by asuffield nad \broken.
-	if ($args =~ /^["']/ and $args =~ /["']$/) {
-	    &DEBUG("list*: removed quotes.");
-	    $args	=~ s/^["']|["']$//g;
-	}
+	my $thiscmd	= lc $1;
+	my $args	= $3 || "";
 
-	$thiscmd =~ s/^vals$/values/;
+	$thiscmd	=~ s/^vals$/values/;
+#	$args		=~ s/\s+$//g;
 	return if ($thiscmd ne "keys" && $thiscmd ne "values");
 
 	# Usage:
-	if (!defined $args) {
+	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 == 1) {
 	    &msg($who,"search string is too short.");
 	    return;
@@ -326,7 +440,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 ($_%)");
 	    }
 
@@ -356,7 +470,7 @@ sub Modules {
     }
 
     # Topic management. xk++
-    # may want to add a flag(??) for topic in the near future. -xk
+    # may want to add a userflags for topic. -xk
     if ($message =~ /^topic(\s+(.*))?$/i) {
 	return unless (&hasParam("topic"));
 
@@ -455,9 +569,10 @@ sub uptime {
 
 # seen.
 sub seen {
-    my($person) = @_;
+    my($person) = lc shift;
+    $person =~ s/\?*$//;
 
-    if (!defined $person) {
+    if (!defined $person or $person =~ /^$/) {
 	&help("seen");
 
 	my $i = &countKeys("seen");
@@ -468,16 +583,15 @@ sub seen {
     }
 
     my @seen;
-    $person =~ s/\?*$//;
 
     &seenFlush();	# very evil hack. oh well, better safe than sorry.
 
-    ### TODO: Support &dbGetRowInfo(); like in &FactInfo();
+    ### TODO: Support &dbGetColInfo(); like in &FactInfo();
     my $select = "nick,time,channel,host,message";
     if ($person eq "random") {
 	@seen = &randKey("seen", $select);
     } else {
-	@seen = &dbGet("seen", "nick", $person, $select);
+	@seen = &dbGet("seen", $select, "nick=".&dbQuote($person) );
     }
 
     if (scalar @seen < 2) {
@@ -492,7 +606,7 @@ sub seen {
     my $reply;
     ### TODO: multi channel support. may require &IsNick() to return
     ###	all channels or something.
-    my @chans = &GetNickInChans($seen[0]);
+    my @chans = &getNickInChans($seen[0]);
     if (scalar @chans) {
 	$reply = "$seen[0] is currently on";
 
@@ -516,7 +630,7 @@ sub seen {
 		 "saying\002:\002 '$seen[4]'.";
     }
 
-    &performStrictReply($reply);
+    &pSReply($reply);
     return;
 }
 
@@ -551,7 +665,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.
@@ -615,7 +729,7 @@ sub lart {
 	}
     }
 
-    my $line = &getRandomLineFromFile($bot_misc_dir. "/blootbot.lart");
+    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;
@@ -688,12 +802,24 @@ sub do_verstats {
 	return;
     }
 
-    &msg($who, "Sending CTCP VERSION...");
+    &msg($who, "Sending CTCP VERSION to #$chan...");
     $conn->ctcp("VERSION", $chan);
     $cache{verstats}{chan}	= $chan;
     $cache{verstats}{who}	= $who;
     $cache{verstats}{msgType}	= $msgType;
 
+    $conn->schedule(30, sub {
+	my $c		= lc $cache{verstats}{chan};
+	@vernicktodo	= ();
+
+	foreach (keys %{ $channels{$c}{''} } ) {
+	    next if (grep /^\Q$_\E$/i, @vernick);
+	    push(@vernicktodo, $_);
+	}
+
+	&verstats_flush();
+    } );
+
     $conn->schedule(60, sub {
 	my $vtotal	= 0;
 	my $c		= lc $cache{verstats}{chan};
@@ -711,7 +837,7 @@ sub do_verstats {
 	my $unknown	= $total - $vtotal;
 	my $perc	= sprintf("%.1f", $unknown * 100 / $total);
 	$perc		=~ s/.0$//;
-	$sorted{$perc}{"unknown/cloak"} = "$unknown ($perc%)";
+	$sorted{$perc}{"unknown/cloak"} = "$unknown ($perc%)" if ($unknown);
 
 	foreach (keys %ver) {
 	    my $count	= scalar keys %{ $ver{$_} };
@@ -740,6 +866,101 @@ sub do_verstats {
     return;
 }
 
+sub verstats_flush {
+    for (1..5) {
+	last unless (scalar @vernicktodo);
+
+	my $n = shift(@vernicktodo);
+	$conn->ctcp("VERSION", $n);
+    }
+
+    return unless (scalar @vernicktodo);
+
+    $conn->schedule(3, \&verstats_flush() );
+}
+
+sub textstats_main {
+    my($arg) = @_;
+
+    # even more uglier with channel/time arguments.
+    my $c	= $chan;
+#    my $c	= $chan || "PRIVATE";
+    my $where	= "channel=".&dbQuote($c) if (defined $c);
+    &DEBUG("not using chan arg") if (!defined $c);
+    my $sum = (&dbRawReturn("SELECT SUM(counter) FROM stats"
+		." WHERE ".$where ))[0];
+
+    if (!defined $arg or $arg =~ /^\s*$/) {
+	# this is way fucking ugly.
+	&DEBUG("_stats: !arg");
+
+	my %hash = &dbGetCol("stats", "nick,counter",
+		$where." ORDER BY counter DESC LIMIT 3", 1);
+	my $i;
+	my @top;
+
+	# unfortunately we have to sort it again!
+	# todo: make dbGetCol return hash and array? too much effort.
+	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 = "";
+	&DEBUG("*stats: tp => $tp");
+	if (scalar @top) {
+	    $topstr = ".  Top ".scalar(@top).": ".join(', ', @top);
+	}
+
+	if (defined $sum) {
+	    &pSReply("total count of \037$type\037 on \002$c\002: $sum$topstr");
+	} else {
+	    &pSReply("zero counter for \037$type\037.");
+	}
+    } else {
+	my %hash = &dbGetCol("stats", "type,counter",
+		"$where AND nick=".&dbQuote($arg) );
+
+	foreach (keys %hash) {
+	    &DEBUG("_stats: hash{$_} => $hash{$_}");
+	    # ranking.
+	    my @array = &dbGet("stats", "nick",
+		$where." ORDER BY counter", 1);
+	    my $good = 0;
+	    my $i = 0;
+	    for($i=0; $i<scalar @array; $i++) {
+		next unless ($array[0] =~ /^\Q$who\E$/);
+		$good++;
+		last;
+	    }
+	    $i++;
+
+	    my $total = scalar(@array);
+	    &DEBUG("   i => $i, good => $good, total => $total");
+	}
+
+	return;
+
+	if (!defined $x) {	# !defined.
+	    &pSReply("$arg has not said $type yet.");
+	    return;
+	}
+
+	my $xtra = "";
+	if ($total and $good) {
+	    my $pct = sprintf("%.01f", 100*(1+$total-$i)/$total);
+	    $xtra = ", ranked $i\002/\002$total (percentile: \002$pct\002 %)";
+	}
+
+	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,$_); } }