2 # Factoids.pl: Helpers for generating factoids statistics.
4 # Version: v0.1 (20000514)
5 # Splitted: SQLExtras.pl
8 if (&IsParam("useStrict")) { use strict; }
11 # Usage: &CmdFactInfo($faqtoid, $query);
13 my ($faqtoid, $query) = (lc $_[0], $_[1]);
24 my @factinfo = &getFactInfo($faqtoid,"*");
25 foreach ( &dbGetRowInfo("factoids") ) {
26 $factinfo{$_} = $factinfo[$i] || '';
30 # factoid does not exist.
31 if (scalar @factinfo <= 1) {
32 &performReply("there's no such factoid as \002$faqtoid\002");
37 if ($factinfo{'created_by'}) {
39 $factinfo{'created_by'} =~ s/\!/ </;
40 $factinfo{'created_by'} .= ">";
41 $string = "created by $factinfo{'created_by'}";
43 my $time = $factinfo{'created_time'};
45 if (time() - $time > 60*60*24*7) {
46 $string .= " at \037". scalar(localtime $time). "\037";
48 $string .= " ".&Time2String(time() - $time)." ago";
56 # if ($factinfo{'modified_by'}) {
57 # $string = "last modified";
59 # my $time = $factinfo{'modified_time'};
61 # if (time() - $time > 60*60*24*7) {
62 # $string .= " at \037". scalar(localtime $time). "\037";
64 # $string .= " ".&Time2String(time() - $time)." ago";
69 # foreach (split ",", $factinfo{'modified_by'}) {
73 # $string .= "by ".&IJoin(@x);
76 # push(@array,$string);
80 if ($factinfo{'requested_by'}) {
81 my $requested_count = $factinfo{'requested_count'};
83 if ($requested_count) {
84 $string = "it has been requested ";
85 if ($requested_count == 1) {
86 $string .= "\002once\002";
88 $string .= "\002". $requested_count. "\002 ".
89 &fixPlural("time", $requested_count);
93 $string .= ", " if ($string ne "");
95 my $requested_by = $factinfo{'requested_by'};
96 $requested_by =~ /\!/;
97 $string .= "last by $`";
99 my $requested_time = $factinfo{'requested_time'};
100 if ($requested_time) {
101 if (time() - $requested_time > 60*60*24*7) {
102 $string .= " at \037". scalar(localtime $requested_time). "\037";
104 $string .= ", ".&Time2String(time() - $requested_time)." ago";
108 push(@array,$string);
112 if ($factinfo{'locked_by'}) {
113 $factinfo{'locked_by'} =~ /\!/;
114 $string = "it has been locked by $`";
116 push(@array, $string);
119 # factoid was inserted not through the bot.
120 if (!scalar @array) {
121 &performReply("no extra info on \002$faqtoid\002");
125 &performStrictReply("$factinfo{'factoid_key'} -- ". join("; ", @array) .".");
132 if ($type =~ /^author$/i) {
133 my %hash = &dbGetCol("factoids", "factoid_key","created_by");
136 foreach (keys %hash) {
137 my $thisnuh = $hash{$_};
139 $thisnuh =~ /^(\S+)!\S+@\S+$/;
143 if (!scalar keys %author) {
144 return 'sorry, no factoids with created_by field.';
149 foreach (keys %author) {
150 $count{ $author{$_} }{$_} = 1;
156 foreach $count (sort { $b <=> $a } keys %count) {
157 my $author = join(", ", sort keys %{$count{$count}});
158 push(@list, "$count by $author");
161 my $prefix = "factoid statistics by author: ";
162 return &formListReply(0, $prefix, @list);
164 } elsif ($type =~ /^broken$/i) {
165 &status("factstats(broken): starting...");
166 my $start_time = &gettimeofday();
167 my %data = &dbGetCol("factoids", "factoid_key","factoid_value");
170 my $delta_time = &gettimeofday() - $start_time;
171 &status(sprintf("factstats(broken): %.02f sec to retreive all factoids.", $delta_time)) if ($delta_time > 0);
172 $start_time = &gettimeofday();
174 # parse the factoids.
175 foreach (keys %data) {
176 if (&validFactoid($_, $data{$_}) == 0) {
177 s/([\,\;]+)/\037$1\037/g; # highlight chars.
178 push(@list, $_); # push it.
182 $delta_time = &gettimeofday() - $start_time;
183 &status(sprintf("factstats(broken): %.02f sec to complete.", $delta_time)) if ($delta_time > 0);
185 # bail out on no results.
186 if (scalar @list == 0) {
187 return 'no broken factoids... wooohoo.';
191 my $prefix = "broken factoid ";
192 return &formListReply(1, $prefix, @list);
194 } elsif ($type =~ /^deadredir$/i) {
195 my @list = &searchTable("factoids", "factoid_key",
196 "factoid_value", "^<REPLY> see ");
202 my $val = &getFactInfo($factoid, "factoid_value");
203 if ($val =~ /^<REPLY> see( also)? (.*?)\.?$/i) {
205 my $redir = &getFactInfo($redirf, "factoid_value");
206 next if (defined $redir);
208 $redir{$redirf}{$factoid} = 1;
213 foreach $f (keys %redir) {
214 my @sublist = keys %{$redir{$f}};
216 s/([\,\;]+)/\037$1\037/g;
219 push(@newlist, join(', ', @sublist)." => $f");
223 my $prefix = "Loose link (dead) redirections in factoids ";
224 return &formListReply(1, $prefix, @newlist);
226 } elsif ($type =~ /^dup(licate|e)$/i) {
227 my $start_time = &gettimeofday();
228 &status("factstats(dupe): starting...");
229 my %hash = &dbGetCol("factoids", "factoid_key", "factoid_value", 1);
234 foreach $v (keys %hash) {
235 my $count = scalar(keys %{$hash{$v}});
236 next if ($count == 1);
239 foreach (keys %{$hash{$v}}) {
240 if ($v =~ /^<REPLY> see /i) {
245 s/([\,\;]+)/\037$1\037/g;
247 &WARN("dupe: _ = NULL. should never happen!.");
253 next unless (scalar @sublist);
255 push(@list, join(", ", @sublist));
258 &status("factstats(dupe): (good) dupe refs: $refs.");
259 my $delta_time = &gettimeofday() - $start_time;
260 &status(sprintf("factstats(dupe): %.02f sec to complete", $delta_time)) if ($delta_time > 0);
262 # bail out on no results.
263 if (scalar @list == 0) {
264 return "no duplicate factoids... woohoo.";
268 my $prefix = "dupe factoid ";
269 return &formListReply(1, $prefix, @list);
271 } elsif ($type =~ /^lame$/i) {
272 # Custom select statement.
273 my $query = "SELECT factoid_key,factoid_value FROM factoids WHERE length(factoid_value) <= 40";
274 my $sth = $dbh->prepare($query);
275 &ERROR("factstats(lame): => '$query'.") unless $sth->execute;
278 while (my @row = $sth->fetchrow_array) {
279 my($key,$val) = ($row[0], $row[1]);
280 next if ($val =~ /^</);
281 next if ($val =~ /\s{2,}/);
283 $key =~ s/\,/\037\,\037/g;
289 my $prefix = "Lame factoids ";
290 return &formListReply(1, $prefix, @list);
292 } elsif ($type =~ /^locked$/i) {
293 my %hash = &dbGetCol("factoids", "factoid_key","locked_by");
294 my @list = keys %hash;
297 s/([\,\;]+)/\037$1\037/g;
300 my $prefix = "factoid statistics on $type ";
301 return &formListReply(0, $prefix, @list);
303 } elsif ($type =~ /^new$/i) {
304 my %hash = &dbGetCol("factoids", "factoid_key","created_time");
307 foreach (keys %hash) {
308 my $created_time = $hash{$_};
309 my $delta_time = time() - $created_time;
310 next if ($delta_time >= 60*60*24);
312 $age{$delta_time}{$_} = 1;
315 if (scalar keys %age == 0) {
316 return "sorry, no new factoids.";
320 foreach (sort {$a <=> $b} keys %age) {
321 push(@list, join(",", keys %{$age{$_}}));
324 my $prefix = "new factoids in the last 24hours ";
325 return &formListReply(0, $prefix, @list);
327 } elsif ($type =~ /^part(ial)?dupe$/i) {
328 ### requires "custom" select statement... oh well...
329 my $start_time = &gettimeofday();
331 # form length|key and key=length hash list.
332 &status("factstats(partdupe): forming length hash list.");
333 my $query = "SELECT factoid_key,factoid_value,length(factoid_value) AS length FROM factoids WHERE length(factoid_value) >= 192 ORDER BY length";
334 my $sth = $dbh->prepare($query);
335 &ERROR("factstats(partdupe): => '$query'.") unless $sth->execute;
339 while (my @row = $sth->fetchrow_array) {
340 $length{$row[2]}{$row[0]} = 1; # length(value)|key.
341 $key{$row[0]} = $row[1]; # key=value.
345 &status("factstats(partdupe): total keys => '". scalar(@key) ."'.");
346 &status("factstats(partdupe): now deciphering data gathered");
348 my @length = sort { $a <=> $b } keys %length;
351 foreach $key (@key) {
352 shift @length if (length $key{$key} == $length[0]);
354 my $val = quotemeta $key{$key};
357 foreach $length (@length) {
358 foreach (keys %{$length{$length}}) {
359 if ($key{$_} =~ /^$val/i) {
360 s/([\,\;]+)/\037$1\037/g;
361 s/( and|and )/\037$1\037/g;
362 push(@sublist,$key." and ".$_);
366 push(@list, join(" ,",@sublist)) if (scalar @sublist);
369 my $delta_time = sprintf("%.02fs", &gettimeofday() - $start_time);
370 &status("factstats(partdupe): $delta_time sec to complete.") if ($delta_time > 0);
372 # bail out on no results.
373 if (scalar @list == 0) {
374 return "no initial partial duplicate factoids... woohoo.";
378 my $prefix = "initial partial dupe factoid ";
379 return &formListReply(1, $prefix, @list);
381 } elsif ($type =~ /^profanity$/i) {
382 my %data = &dbGetCol("factoids", "factoid_key","factoid_value");
385 foreach (keys %data) {
386 push(@list, $_) if (&hasProfanity($_." ".$data{$_}));
390 my $prefix = "Profanity in factoids ";
391 return &formListReply(1, $prefix, @list);
393 } elsif ($type =~ /^redir(ection)?$/i) {
394 my @list = &searchTable("factoids", "factoid_key",
395 "factoid_value", "^<REPLY> see ");
401 my $val = &getFactInfo($factoid, "factoid_value");
402 if ($val =~ /^<REPLY> see( also)? (.*?)\.?$/i) {
404 my $redirval = &getFactInfo($redir, "factoid_value");
405 if (defined $redirval) {
406 $redir{$redir}{$factoid} = 1;
408 &WARN("factstats(redir): '$factoid' has loose link => '$redir'.");
414 foreach $f (keys %redir) {
415 my @sublist = keys %{$redir{$f}};
417 s/([\,\;]+)/\037$1\037/g;
420 push(@newlist, "$f => ". join(', ', @sublist));
424 my $prefix = "Redirections in factoids ";
425 return &formListReply(1, $prefix, @newlist);
427 } elsif ($type =~ /^request(ed)?$/i) {
428 my %hash = &dbGetCol("factoids", "factoid_key", "requested_count",1);
430 if (!scalar keys %hash) {
431 return 'sorry, no factoids have been questioned.';
436 foreach $count (sort {$b <=> $a} keys %hash) {
437 my @faqtoids = sort keys %{$hash{$count}};
440 s/([\,\;]+)/\037$1\037/g;
443 push(@list, "$count - ". join(", ", @faqtoids));
446 my $prefix = "factoid statistics on $type ";
447 return &formListReply(0, $prefix, @list);
449 } elsif ($type =~ /^requesters?$/i) {
450 my %hash = &dbGetCol("factoids", "factoid_key","requested_by");
453 foreach (keys %hash) {
454 my $thisnuh = $hash{$_};
456 $thisnuh =~ /^(\S+)!\S+@\S+$/;
460 if (!scalar keys %requester) {
461 return 'sorry, no factoids with requested_by field.';
466 foreach (keys %requester) {
467 $count{$requester{$_}}{$_} = 1;
473 foreach $count (sort { $b <=> $a } keys %count) {
474 my $requester = join(", ", sort keys %{$count{$count}});
475 push(@list, "$count by $requester");
478 my $prefix = "rank of top factoid requesters: ";
479 return &formListReply(0, $prefix, @list);
481 } elsif ($type =~ /^seefix$/i) {
482 my @list = &searchTable("factoids", "factoid_key",
483 "factoid_value", "^see ");
490 my $val = &getFactInfo($factoid, "factoid_value");
491 if ($val =~ /^see( also)? (.*?)\.?$/i) {
493 my $redir = &getFactInfo($redirf, "factoid_value");
495 if (defined $redir) { # good.
496 &setFactInfo($factoid,"factoid_value","<REPLY> see $redir");
499 $redir{$redirf}{$factoid} = 1;
505 foreach $f (keys %redir) {
506 my @sublist = keys %{$redir{$f}};
508 s/([\,\;]+)/\037$1\037/g;
511 push(@newlist, join(', ', @sublist)." => $f");
515 &performReply("Fixed $fixed factoids.");
516 my $prefix = "Loose link (dead) redirections in factoids ";
517 return &formListReply(1, $prefix, @newlist);
519 } elsif ($type =~ /^(2|too)long$/i) {
523 $query = "SELECT factoid_key FROM factoids WHERE length(factoid_key) >= $param{'maxKeySize'}";
524 my $sth = $dbh->prepare($query);
526 while (my @row = $sth->fetchrow_array) {
531 my $query = "SELECT factoid_key,factoid_value FROM factoids WHERE length(factoid_value) >= $param{'maxDataSize'}";
532 $sth = $dbh->prepare($query);
534 while (my @row = $sth->fetchrow_array) {
535 push(@list,sprintf("\002%s\002 - %s", length($row[1]), $row[0]));
538 if (scalar @list == 0) {
539 return "good. no factoids exceed length.";
543 my $prefix = "factoid key||value exceeding length ";
544 return &formListReply(1, $prefix, @list);
546 } elsif ($type =~ /^unrequest(ed)?$/i) {
547 my @list = &dbRawReturn("SELECT factoid_key FROM factoids WHERE requested_count IS NULL");
550 s/([\,\;]+)/\037$1\037/g;
553 my $prefix = "Unrequested factoids ";
554 return &formListReply(0, $prefix, @list);
557 return "error: invalid type => '$type'.";
562 my @list = &searchTable("factoids","factoid_key", "created_by", "^$query!");
564 my $prefix = "factoid author list by '$query' ";
565 &performStrictReply( &formListReply(1, $prefix, @list) );