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");
36 # fix for problem observed by asuffield.
37 # why did it happen though?
38 if (!$factinfo{'factoid_value'}) {
39 &performReply("there's no such factoid as \002$faqtoid\002; deleted because we don't have factoid_value!");
40 foreach (keys %factinfo) {
41 &DEBUG("factinfo{$_} => '$factinfo{$_}'.");
43 ### &delFactoid($faqtoid);
48 if ($factinfo{'created_by'}) {
50 $factinfo{'created_by'} =~ s/\!/ </;
51 $factinfo{'created_by'} .= ">";
52 $string = "created by $factinfo{'created_by'}";
54 my $time = $factinfo{'created_time'};
56 if (time() - $time > 60*60*24*7) {
57 my $days = int( (time() - $time)/60/60/24 );
58 $string .= " at \037". scalar(localtime $time). "\037" .
61 $string .= " ".&Time2String(time() - $time)." ago";
69 # if ($factinfo{'modified_by'}) {
70 # $string = "last modified";
72 # my $time = $factinfo{'modified_time'};
74 # if (time() - $time > 60*60*24*7) {
75 # $string .= " at \037". scalar(localtime $time). "\037";
77 # $string .= " ".&Time2String(time() - $time)." ago";
82 # foreach (split ",", $factinfo{'modified_by'}) {
86 # $string .= "by ".&IJoin(@x);
89 # push(@array,$string);
93 if ($factinfo{'requested_by'}) {
94 my $requested_count = $factinfo{'requested_count'};
96 if ($requested_count) {
97 $string = "it has been requested ";
98 if ($requested_count == 1) {
99 $string .= "\002once\002";
101 $string .= "\002". $requested_count. "\002 ".
102 &fixPlural("time", $requested_count);
106 $string .= ", " if ($string ne "");
108 my $requested_by = $factinfo{'requested_by'};
109 $requested_by =~ /\!/;
110 $string .= "last by $`";
112 my $requested_time = $factinfo{'requested_time'};
113 if ($requested_time) {
114 if (time() - $requested_time > 60*60*24*7) {
115 $string .= " at \037". scalar(localtime $requested_time). "\037";
117 $string .= ", ".&Time2String(time() - $requested_time)." ago";
121 push(@array,$string);
125 if ($factinfo{'locked_by'}) {
126 $factinfo{'locked_by'} =~ /\!/;
127 $string = "it has been locked by $`";
129 push(@array, $string);
132 # factoid was inserted not through the bot.
133 if (!scalar @array) {
134 &performReply("no extra info on \002$faqtoid\002");
138 &performStrictReply("$factinfo{'factoid_key'} -- ". join("; ", @array) .".");
145 if ($type =~ /^author$/i) {
146 my %hash = &dbGetCol("factoids", "factoid_key","created_by");
149 foreach (keys %hash) {
150 my $thisnuh = $hash{$_};
152 $thisnuh =~ /^(\S+)!\S+@\S+$/;
156 if (!scalar keys %author) {
157 return 'sorry, no factoids with created_by field.';
162 foreach (keys %author) {
163 $count{ $author{$_} }{$_} = 1;
169 foreach $count (sort { $b <=> $a } keys %count) {
170 my $author = join(", ", sort keys %{$count{$count}});
171 push(@list, "$count by $author");
174 my $prefix = "factoid statistics by author: ";
175 return &formListReply(0, $prefix, @list);
177 } elsif ($type =~ /^broken$/i) {
178 &status("factstats(broken): starting...");
179 my $start_time = &timeget();
180 my %data = &dbGetCol("factoids", "factoid_key","factoid_value");
183 my $delta_time = &timedelta($start_time);
184 &status(sprintf("factstats(broken): %.02f sec to retreive all factoids.", $delta_time)) if ($delta_time > 0);
185 $start_time = &timeget();
187 # parse the factoids.
188 foreach (keys %data) {
189 if (&validFactoid($_, $data{$_}) == 0) {
190 s/([\,\;]+)/\037$1\037/g; # highlight chars.
191 push(@list, $_); # push it.
195 $delta_time = &timedelta($start_time);
196 &status(sprintf("factstats(broken): %.02f sec to complete.", $delta_time)) if ($delta_time > 0);
198 # bail out on no results.
199 if (scalar @list == 0) {
200 return 'no broken factoids... wooohoo.';
204 my $prefix = "broken factoid ";
205 return &formListReply(1, $prefix, @list);
207 } elsif ($type =~ /^deadredir$/i) {
208 my @list = &searchTable("factoids", "factoid_key",
209 "factoid_value", "^<REPLY> see ");
215 my $val = &getFactInfo($factoid, "factoid_value");
216 if ($val =~ /^<REPLY> see( also)? (.*?)\.?$/i) {
218 my $redir = &getFactInfo($redirf, "factoid_value");
219 next if (defined $redir);
220 next if (length $val > 50);
222 $redir{$redirf}{$factoid} = 1;
227 foreach $f (keys %redir) {
228 my @sublist = keys %{ $redir{$f} };
230 s/([\,\;]+)/\037$1\037/g;
233 push(@newlist, join(', ', @sublist)." => $f");
237 my $prefix = "Loose link (dead) redirections in factoids ";
238 return &formListReply(1, $prefix, @newlist);
240 } elsif ($type =~ /^dup(licate|e)$/i) {
241 &status("factstats(dupe): starting...");
242 my $start_time = &timeget();
243 my %hash = &dbGetCol("factoids", "factoid_key", "factoid_value", 1);
248 foreach $v (keys %hash) {
249 my $count = scalar(keys %{$hash{$v}});
250 next if ($count == 1);
253 foreach (keys %{$hash{$v}}) {
254 if ($v =~ /^<REPLY> see /i) {
259 s/([\,\;]+)/\037$1\037/g;
261 &WARN("dupe: _ = NULL. should never happen!.");
267 next unless (scalar @sublist);
269 push(@list, join(", ", @sublist));
272 &status("factstats(dupe): (good) dupe refs: $refs.");
273 my $delta_time = &timedelta($start_time);
274 &status(sprintf("factstats(dupe): %.02f sec to complete", $delta_time)) if ($delta_time > 0);
276 # bail out on no results.
277 if (scalar @list == 0) {
278 return "no duplicate factoids... woohoo.";
282 my $prefix = "dupe factoid ";
283 return &formListReply(1, $prefix, @list);
285 } elsif ($type =~ /^nullfactoids$/i) {
286 my $query = "SELECT factoid_key,factoid_value FROM factoids WHERE factoid_value=''";
287 my $sth = $dbh->prepare($query);
288 &ERROR("factstats(null): => '$query'.") unless $sth->execute;
291 while (my @row = $sth->fetchrow_array) {
293 &DEBUG("row[1] != NULL for $row[0].");
297 &DEBUG("row[0] => '$row[0]'.");
298 push(@list, $row[0]);
303 my $prefix = "NULL factoids (not deleted yet) ";
304 return &formListReply(1, $prefix, @list);
306 } elsif ($type =~ /^(2|too)short$/i) {
307 # Custom select statement.
308 my $query = "SELECT factoid_key,factoid_value FROM factoids WHERE length(factoid_value) <= 40";
309 my $sth = $dbh->prepare($query);
310 &ERROR("factstats(lame): => '$query'.") unless $sth->execute;
313 while (my @row = $sth->fetchrow_array) {
314 my($key,$val) = ($row[0], $row[1]);
316 $match++ if ($val =~ /\s{3,}/);
317 next unless ($match);
319 my $v = &getFactoid($val);
321 &DEBUG("key $key => $val => $v");
324 $key =~ s/\,/\037\,\037/g;
330 my $prefix = "Lame factoids ";
331 return &formListReply(1, $prefix, @list);
333 } elsif ($type =~ /^listfix$/i) {
334 # Custom select statement.
335 my $query = "SELECT factoid_key,factoid_value FROM factoids";
336 my $sth = $dbh->prepare($query);
337 &ERROR("factstats(listfix): => '$query'.") unless $sth->execute;
340 while (my @row = $sth->fetchrow_array) {
341 my($key,$val) = ($row[0], $row[1]);
343 $match++ if ($val =~ /\S+,? or \S+,? or \S+,? or \S+,?/);
344 next unless ($match);
346 $key =~ s/\,/\037\,\037/g;
348 $val =~ s/,? or /, /g;
349 &DEBUG("fixed: => $val.");
350 &setFactInfo($key,"factoid_value", $val);
355 my $prefix = "Inefficient lists fixed ";
356 return &formListReply(1, $prefix, @list);
358 } elsif ($type =~ /^locked$/i) {
359 my %hash = &dbGetCol("factoids", "factoid_key","locked_by");
360 my @list = keys %hash;
363 s/([\,\;]+)/\037$1\037/g;
366 my $prefix = "factoid statistics on $type ";
367 return &formListReply(0, $prefix, @list);
369 } elsif ($type =~ /^new$/i) {
370 my %hash = &dbGetCol("factoids", "factoid_key","created_time");
373 foreach (keys %hash) {
374 my $created_time = $hash{$_};
375 my $delta_time = time() - $created_time;
376 next if ($delta_time >= 60*60*24);
378 $age{$delta_time}{$_} = 1;
381 if (scalar keys %age == 0) {
382 return "sorry, no new factoids.";
386 foreach (sort {$a <=> $b} keys %age) {
387 push(@list, join(",", keys %{$age{$_}}));
390 my $prefix = "new factoids in the last 24hours ";
391 return &formListReply(0, $prefix, @list);
393 } elsif ($type =~ /^part(ial)?dupe$/i) {
394 ### requires "custom" select statement... oh well...
395 my $start_time = &timeget();
397 # form length|key and key=length hash list.
398 &status("factstats(partdupe): forming length hash list.");
399 my $query = "SELECT factoid_key,factoid_value,length(factoid_value) AS length FROM factoids WHERE length(factoid_value) >= 192 ORDER BY length";
400 my $sth = $dbh->prepare($query);
401 &ERROR("factstats(partdupe): => '$query'.") unless $sth->execute;
405 while (my @row = $sth->fetchrow_array) {
406 $length{$row[2]}{$row[0]} = 1; # length(value)|key.
407 $key{$row[0]} = $row[1]; # key=value.
411 &status("factstats(partdupe): total keys => '". scalar(@key) ."'.");
412 &status("factstats(partdupe): now deciphering data gathered");
414 my @length = sort { $a <=> $b } keys %length;
417 foreach $key (@key) {
418 shift @length if (length $key{$key} == $length[0]);
420 my $val = quotemeta $key{$key};
423 foreach $length (@length) {
424 foreach (keys %{$length{$length}}) {
425 if ($key{$_} =~ /^$val/i) {
426 s/([\,\;]+)/\037$1\037/g;
427 s/( and|and )/\037$1\037/g;
428 push(@sublist,$key." and ".$_);
432 push(@list, join(" ,",@sublist)) if (scalar @sublist);
435 my $delta_time = sprintf("%.02fs", &timedelta($start_time) );
436 &status("factstats(partdupe): $delta_time sec to complete.") if ($delta_time > 0);
438 # bail out on no results.
439 if (scalar @list == 0) {
440 return "no initial partial duplicate factoids... woohoo.";
444 my $prefix = "initial partial dupe factoid ";
445 return &formListReply(1, $prefix, @list);
447 } elsif ($type =~ /^profanity$/i) {
448 my %data = &dbGetCol("factoids", "factoid_key","factoid_value");
451 foreach (keys %data) {
452 push(@list, $_) if (&hasProfanity($_." ".$data{$_}));
456 my $prefix = "Profanity in factoids ";
457 return &formListReply(1, $prefix, @list);
459 } elsif ($type =~ /^redir(ection)?$/i) {
460 my @list = &searchTable("factoids", "factoid_key",
461 "factoid_value", "^<REPLY> see ");
467 my $val = &getFactInfo($factoid, "factoid_value");
468 if ($val =~ /^<REPLY> see( also)? (.*?)\.?$/i) {
470 my $redirval = &getFactInfo($redir, "factoid_value");
471 if (defined $redirval) {
472 $redir{$redir}{$factoid} = 1;
474 &WARN("factstats(redir): '$factoid' has loose link => '$redir'.");
480 foreach $f (keys %redir) {
481 my @sublist = keys %{$redir{$f}};
483 s/([\,\;]+)/\037$1\037/g;
486 push(@newlist, "$f => ". join(', ', @sublist));
490 my $prefix = "Redirections in factoids ";
491 return &formListReply(1, $prefix, @newlist);
493 } elsif ($type =~ /^request(ed)?$/i) {
494 my %hash = &dbGetCol("factoids", "factoid_key", "requested_count",1);
496 if (!scalar keys %hash) {
497 return 'sorry, no factoids have been questioned.';
503 foreach $count (sort {$b <=> $a} keys %hash) {
504 my @faqtoids = sort keys %{ $hash{$count} };
507 s/([\,\;]+)/\037$1\037/g;
509 $total += $count * scalar(@faqtoids);
511 push(@list, "$count - ". join(", ", @faqtoids));
513 unshift(@list, "\037$total - TOTAL\037");
515 my $prefix = "factoid statistics on $type ";
516 return &formListReply(0, $prefix, @list);
518 } elsif ($type =~ /^requesters?$/i) {
519 my %hash = &dbGetCol("factoids", "factoid_key","requested_by");
522 foreach (keys %hash) {
523 my $thisnuh = $hash{$_};
525 $thisnuh =~ /^(\S+)!\S+@\S+$/;
529 if (!scalar keys %requester) {
530 return 'sorry, no factoids with requested_by field.';
535 foreach (keys %requester) {
536 $count{$requester{$_}}{$_} = 1;
544 foreach $count (sort { $b <=> $a } keys %count) {
545 my $requester = join(", ", sort keys %{ $count{$count} });
546 $total += $count * scalar(keys %{ $count{$count} });
547 $users += scalar(keys %{ $count{$count} });
548 push(@list, "$count by $requester");
550 unshift(@list, "\037$total TOTAL REQUESTS; $users UNIQUE REQUESTERS\037");
551 # should not the above value be the same as collected by
552 # 'requested'? soemthing weird is going on!
554 my $prefix = "rank of top factoid requesters: ";
555 return &formListReply(0, $prefix, @list);
557 } elsif ($type =~ /^seefix$/i) {
558 my @list = &searchTable("factoids", "factoid_key",
559 "factoid_value", "^see ");
567 my $val = &getFactInfo($factoid, "factoid_value");
569 next unless ($val =~ /^see( also)? (.*?)\.?$/i);
572 my $redir = &getFactInfo($redirf, "factoid_value");
574 if ($redirf =~ /^\Q$factoid\W$/i) {
575 &delFactoid($factoid);
579 if (defined $redir) { # good.
580 &setFactInfo($factoid,"factoid_value","<REPLY> see $redir");
583 push(@newlist, $redirf);
588 &msg($who, "Fixed $fixed factoids.");
589 &msg($who, "Self looped factoids removed: ".
590 sort(keys %loop) ) if (scalar keys %loop);
592 my $prefix = "Loose link (dead) redirections in factoids ";
593 return &formListReply(1, $prefix, @newlist);
595 } elsif ($type =~ /^(2|too)long$/i) {
599 $query = "SELECT factoid_key FROM factoids WHERE length(factoid_key) >= $param{'maxKeySize'}";
600 my $sth = $dbh->prepare($query);
602 while (my @row = $sth->fetchrow_array) {
607 my $query = "SELECT factoid_key,factoid_value FROM factoids WHERE length(factoid_value) >= $param{'maxDataSize'}";
608 $sth = $dbh->prepare($query);
610 while (my @row = $sth->fetchrow_array) {
611 push(@list,sprintf("\002%s\002 - %s", length($row[1]), $row[0]));
614 if (scalar @list == 0) {
615 return "good. no factoids exceed length.";
619 my $prefix = "factoid key||value exceeding length ";
620 return &formListReply(1, $prefix, @list);
622 } elsif ($type =~ /^unrequest(ed)?$/i) {
623 my @list = &dbRawReturn("SELECT factoid_key FROM factoids WHERE requested_count IS NULL");
626 s/([\,\;]+)/\037$1\037/g;
629 my $prefix = "Unrequested factoids ";
630 return &formListReply(0, $prefix, @list);
633 return "error: invalid type => '$type'.";
638 my @list = &searchTable("factoids","factoid_key", "created_by", "^$query!");
640 my $prefix = "factoid author list by '$query' ";
641 &performStrictReply( &formListReply(1, $prefix, @list) );