+sub do_verstats {
+ my ($chan) = @_;
+
+ if (!defined $chan) {
+ &help("verstats");
+ return;
+ }
+
+ if (!&validChan($chan)) {
+ &msg($who, "chan $chan is invalid.");
+ return;
+ }
+
+ if (scalar @vernick > scalar(keys %{ $channels{lc $chan}{''} })/4) {
+ &msg($who, "verstats already in progress for someone else.");
+ return;
+ }
+
+ &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};
+ my $total = keys %{ $channels{$c}{''} };
+ $chan = $c;
+ $who = $cache{verstats}{who};
+ $msgType = $cache{verstats}{msgType};
+ delete $cache{verstats}; # sufficient?
+
+ foreach (keys %ver) {
+ $vtotal += scalar keys %{ $ver{$_} };
+ }
+
+ my %sorted;
+ my $unknown = $total - $vtotal;
+ my $perc = sprintf("%.1f", $unknown * 100 / $total);
+ $perc =~ s/.0$//;
+ $sorted{$perc}{"unknown/cloak"} = "$unknown ($perc%)" if ($unknown);
+
+ foreach (keys %ver) {
+ my $count = scalar keys %{ $ver{$_} };
+ $perc = sprintf("%.01f", $count * 100 / $total);
+ $perc =~ s/.0$//; # lame compression.
+
+ $sorted{$perc}{$_} = "$count ($perc%)";
+ }
+
+ ### 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}{$_}");
+ }
+ }
+
+ &pSReply( &formListReply(0, "IRC Client versions for $c ", @list) );
+
+ # clean up not-needed data structures.
+ undef %ver;
+ undef @vernick;
+ } );
+
+ 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,$_); } }
+