src/Modules/Factoids.pl

   1 #
   2 #  Factoids.pl: Helpers for generating factoids statistics.
   3 #       Author: dms
   4 #      Version: v0.1 (20000514)
   5 #     Splitted: SQLExtras.pl
   6 #
   7
   8 use strict;
   9
  10 use vars qw($dbh $who);
  11 use vars qw(%param);
  12
  13 ###
  14 # Usage: &CmdFactInfo($faqtoid, $query);
  15 sub CmdFactInfo {
  16     my ($faqtoid, $query) = (lc $_[0], $_[1]);
  17     my @array;
  18     my $string = "";
  19
  20     if ($faqtoid eq "") {
  21         &help("factinfo");
  22         return;
  23     }
  24
  25     my %factinfo = &sqlSelectRowHash("factoids", "*",
  26         { factoid_key => $faqtoid }
  27     );
  28
  29     # factoid does not exist.
  30     if (scalar (keys %factinfo) <= 1) {
  31         &performReply("there's no such factoid as \002$faqtoid\002");
  32         return;
  33     }
  34
  35     # fix for problem observed by asuffield.
  36     # why did it happen though?
  37     if (!$factinfo{'factoid_value'}) {
  38         &performReply("there's no such factoid as \002$faqtoid\002; deleted because we don't have factoid_value!");
  39         foreach (keys %factinfo) {
  40             &DEBUG("factinfo{$_} => '$factinfo{$_}'.");
  41         }
  42 ###     &delFactoid($faqtoid);
  43         return;
  44     }
  45
  46     # created:
  47     if ($factinfo{'created_by'}) {
  48
  49         $factinfo{'created_by'} =~ s/\!/ </;
  50         $factinfo{'created_by'} .= ">";
  51         $string  = "created by $factinfo{'created_by'}";
  52
  53         my $time = $factinfo{'created_time'};
  54         if ($time) {
  55             if (time() - $time > 60*60*24*7) {
  56                 my $days = int( (time() - $time)/60/60/24 );
  57                 $string .= " at \037". scalar(gmtime $time). "\037" .
  58                                 " ($days days)";
  59             } else {
  60                 $string .= " ".&Time2String(time() - $time)." ago";
  61             }
  62         }
  63
  64         push(@array,$string);
  65     }
  66
  67     # modified:
  68     # disabled for the time being... it's misleading/useless info.
  69     if (0 && $factinfo{'modified_by'}) {
  70         $string = "last modified";
  71
  72         my $time = $factinfo{'modified_time'};
  73         if ($time) {
  74             if (time() - $time > 60*60*24*7) {
  75                 $string .= " at \037". scalar(gmtime $time). "\037";
  76             } else {
  77                 $string .= " ".&Time2String(time() - $time)." ago ";
  78             }
  79         }
  80
  81         $string .= " by ".(split ",", $factinfo{'modified_by'})[0];
  82
  83         push(@array,$string);
  84     }
  85
  86     # requested:
  87     if ($factinfo{'requested_by'}) {
  88         my $requested_count = $factinfo{'requested_count'};
  89
  90         if ($requested_count) {
  91             $string  = "it has been requested ";
  92             if ($requested_count == 1) {
  93                 $string .= "\002once\002";
  94             } else {
  95                 $string .= "\002". $requested_count. "\002 ".
  96                         &fixPlural("time", $requested_count);
  97             }
  98
  99             my $requested_by = $factinfo{'requested_by'};
 100             $requested_by =~ /\!/;
 101             $string .= ", last by $`";
 102
 103             my $requested_time = $factinfo{'requested_time'};
 104             if ($requested_time) {
 105                 if (time() - $requested_time > 60*60*24*7) {
 106                     $string .= " at \037". scalar(localtime $requested_time). "\037";
 107                 } else {
 108                     $string .= ", ".&Time2String(time() - $requested_time)." ago";
 109                 }
 110             }
 111         } else {
 112             $string  = "has not been requested yet";
 113         }
 114
 115         push(@array, $string);
 116     }
 117
 118     # locked:
 119     if ($factinfo{'locked_by'}) {
 120         $factinfo{'locked_by'} =~ /\!/;
 121         $string = "it has been locked by $`";
 122
 123         push(@array, $string);
 124     }
 125
 126     # factoid was inserted not through the bot.
 127     if (!scalar @array) {
 128         &performReply("no extra info on \002$faqtoid\002");
 129         return;
 130     }
 131
 132     &pSReply("$factinfo{'factoid_key'} -- ". join("; ", @array) .".");
 133     return;
 134 }
 135
 136 sub CmdFactStats {
 137     my ($type) = @_;
 138
 139     if ($type =~ /^author$/i) {
 140         my @array = &sqlSelectColArray("factoids",
 141                 "factoid_key,created_by", { },
 142                 "created_by IS NOT NULL"
 143         );
 144         my %author;
 145
 146         foreach (@array) {
 147             my $thisnuh = $hash{$_};
 148
 149             $thisnuh =~ /^(\S+)!\S+@\S+$/;
 150             $author{lc $1}++;
 151         }
 152
 153         if (!scalar keys %author) {
 154             return 'sorry, no factoids with created_by field.';
 155         }
 156
 157         # work-around.
 158         my %count;
 159         foreach (keys %author) {
 160             $count{ $author{$_} }{$_} = 1;
 161         }
 162         undef %author;
 163
 164         my $count;
 165         my @list;
 166         foreach $count (sort { $b <=> $a } keys %count) {
 167             my $author = join(", ", sort keys %{ $count{$count} });
 168             push(@list, "$count by $author");
 169         }
 170
 171         my $prefix = "factoid statistics by author: ";
 172         return &formListReply(0, $prefix, @list);
 173
 174     } elsif ($type =~ /^vandalism$/i) {
 175         &status("factstats(vandalism): starting...");
 176         my $start_time  = &timeget();
 177         my %data        = &sqlSelectColHash("factoids",
 178                 "factoid_key,factoid_value", { },
 179                 "factoid_value IS NOT NULL"
 180         );
 181         my @list;
 182
 183         my $delta_time  = &timedelta($start_time);
 184         &status(sprintf("factstats(vandalismbroken): %.02f sec to retreive all factoids.", $delta_time)) if ($delta_time > 0);
 185         $start_time     = &timeget();
 186
 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.
 192             }
 193         }
 194
 195         $delta_time     = &timedelta($start_time);
 196         &status(sprintf("factstats(vandalism): %.02f sec to complete.", $delta_time)) if ($delta_time > 0);
 197
 198         # bail out on no results.
 199         if (scalar @list == 0) {
 200             return 'no vandalised factoids... wooohoo.';
 201         }
 202
 203         # parse the results.
 204         my $prefix = "Vandalised factoid ";
 205         return &formListReply(1, $prefix, @list);
 206
 207     } elsif ($type =~ /^total$/i) {
 208         &status("factstats(total): starting...");
 209         my $start_time  = &timeget();
 210         my @list;
 211         my $str;
 212         my($i,$j);
 213         my %hash;
 214
 215         ### lets do it.
 216         # total factoids requests.
 217         $i = &sumKey("factoids", "requested_count");
 218         push(@list, "total requests - $i");
 219
 220         # total factoids modified.
 221         $str = &countKeys("factoids", "modified_by");
 222         push(@list, "total modified - $str");
 223
 224         # total factoids modified.
 225         $j      = &countKeys("factoids", "requested_count");
 226         $str    = &countKeys("factoids", "factoid_key");
 227         push(@list, "total non-requested - ".($str - $i));
 228
 229         # average request/factoid.
 230         # i/j == total(requested_count)/count(requested_count)
 231         $str = sprintf("%.01f", $i/$j);
 232         push(@list, "average requested per factoid - $str");
 233
 234         # total prepared for deletion.
 235         $str    = scalar( &searchTable("factoids", "factoid_key", "factoid_value", " #DEL") );
 236         push(@list, "total prepared for deletion - $str");
 237
 238         # total unique authors.
 239         # todo: convert to sqlSelectColHash ? (or ColArray?)
 240         foreach ( &sqlRawReturn("SELECT created_by FROM factoids WHERE created_by IS NOT NULL") ) {
 241             /^(\S+)!/;
 242             my $nick = lc $1;
 243             $hash{$nick}++;
 244         }
 245         push(@list, "total unique authors - ".(scalar keys %hash) );
 246         undef %hash;
 247
 248         # total unique requesters.
 249         foreach ( &sqlRawReturn("SELECT requested_by FROM factoids WHERE requested_by IS NOT NULL") ) {
 250             /^(\S+)!/;
 251             my $nick = lc $1;
 252             $hash{$nick}++;
 253         }
 254         push(@list, "total unique requesters - ".(scalar keys %hash) );
 255         undef %hash;
 256
 257         ### end of "job".
 258
 259         my $delta_time  = &timedelta($start_time);
 260         &status(sprintf("factstats(broken): %.02f sec to retreive all factoids.", $delta_time)) if ($delta_time > 0);
 261         $start_time     = &timeget();
 262
 263         # bail out on no results.
 264         if (scalar @list == 0) {
 265             return 'no broken factoids... wooohoo.';
 266         }
 267
 268         # parse the results.
 269         my $prefix = "General factoid stiatistics ";
 270         return &formListReply(1, $prefix, @list);
 271
 272     } elsif ($type =~ /^deadredir$/i) {
 273         my @list = &searchTable("factoids", "factoid_key",
 274                         "factoid_value", "^<REPLY> see ");
 275         my %redir;
 276         my $f;
 277
 278         for (@list) {
 279             my $factoid = $_;
 280             my $val = &getFactInfo($factoid, "factoid_value");
 281             if ($val =~ /^<REPLY> ?see( also)? (.*?)\.?$/i) {
 282                 my $redirf = lc $2;
 283                 my $redir = &getFactInfo($redirf, "factoid_value");
 284                 next if (defined $redir);
 285                 next if (length $val > 50);
 286
 287                 $redir{$redirf}{$factoid} = 1;
 288             }
 289         }
 290
 291         my @newlist;
 292         foreach $f (keys %redir) {
 293             my @sublist = keys %{ $redir{$f} };
 294             for (@sublist) {
 295                 s/([\,\;]+)/\037$1\037/g;
 296             }
 297
 298             push(@newlist, join(', ', @sublist)." => $f");
 299         }
 300
 301         # parse the results.
 302         my $prefix = "Loose link (dead) redirections in factoids ";
 303         return &formListReply(1, $prefix, @newlist);
 304
 305     } elsif ($type =~ /^dup(licate|e)$/i) {
 306         &status("factstats(dupe): starting...");
 307         my $start_time  = &timeget();
 308         my %hash        = &sqlSelectColHash("factoids",
 309                 "factoid_key,factoid_value", { },
 310                 "factoid_value IS NOT NULL", 1
 311         );
 312         my $refs        = 0;
 313         my @list;
 314         my $v;
 315
 316         foreach $v (keys %hash) {
 317             my $count = scalar(keys %{ $hash{$v} });
 318             next if ($count == 1);
 319
 320             my @sublist;
 321             foreach (keys %{ $hash{$v} }) {
 322                 if ($v =~ /^<REPLY> see /i) {
 323                     $refs++;
 324                     next;
 325                 }
 326
 327                 s/([\,\;]+)/\037$1\037/g;
 328                 if ($_ eq "") {
 329                     &WARN("dupe: _ = NULL. should never happen!.");
 330                     next;
 331                 }
 332                 push(@sublist, $_);
 333             }
 334
 335             next unless (scalar @sublist);
 336
 337             push(@list, join(", ", @sublist));
 338         }
 339
 340         &status("factstats(dupe): (good) dupe refs: $refs.");
 341         my $delta_time  = &timedelta($start_time);
 342         &status(sprintf("factstats(dupe): %.02f sec to complete", $delta_time)) if ($delta_time > 0);
 343
 344         # bail out on no results.
 345         if (scalar @list == 0) {
 346             return "no duplicate factoids... woohoo.";
 347         }
 348
 349         # parse the results.
 350         my $prefix = "dupe factoid ";
 351         return &formListReply(1, $prefix, @list);
 352
 353     } elsif ($type =~ /^nullfactoids$/i) {
 354         my $query = "SELECT factoid_key,factoid_value FROM factoids WHERE factoid_value=''";
 355         my $sth = $dbh->prepare($query);
 356         &ERROR("factstats(null): => '$query'.") unless $sth->execute;
 357
 358         my @list;
 359         while (my @row = $sth->fetchrow_array) {
 360             if ($row[1] ne "") {
 361                 &DEBUG("row[1] != NULL for $row[0].");
 362                 next;
 363             }
 364
 365             &DEBUG("row[0] => '$row[0]'.");
 366             push(@list, $row[0]);
 367         }
 368         $sth->finish;
 369
 370         # parse the results.
 371         my $prefix = "NULL factoids (not deleted yet) ";
 372         return &formListReply(1, $prefix, @list);
 373
 374     } elsif ($type =~ /^(2|too)short$/i) {
 375         # Custom select statement.
 376         my $query = "SELECT factoid_key,factoid_value FROM factoids WHERE length(factoid_value) <= 40";
 377         my $sth = $dbh->prepare($query);
 378         &ERROR("factstats(lame): => '$query'.") unless $sth->execute;
 379
 380         my @list;
 381         while (my @row = $sth->fetchrow_array) {
 382             my($key,$val) = ($row[0], $row[1]);
 383             my $match = 0;
 384             $match++ if ($val =~ /\s{3,}/);
 385             next unless ($match);
 386
 387             my $v = &getFactoid($val);
 388             if (defined $v) {
 389                 &DEBUG("key $key => $val => $v");
 390             }
 391
 392             $key =~ s/\,/\037\,\037/g;
 393             push(@list, $key);
 394         }
 395         $sth->finish;
 396
 397         # parse the results.
 398         my $prefix = "Lame factoids ";
 399         return &formListReply(1, $prefix, @list);
 400
 401     } elsif ($type =~ /^listfix$/i) {
 402         # Custom select statement.
 403         my $query = "SELECT factoid_key,factoid_value FROM factoids";
 404         my $sth = $dbh->prepare($query);
 405         &ERROR("factstats(listfix): => '$query'.") unless $sth->execute;
 406
 407         my @list;
 408         while (my @row = $sth->fetchrow_array) {
 409             my($key,$val) = ($row[0], $row[1]);
 410             my $match = 0;
 411             $match++ if ($val =~ /\S+,? or \S+,? or \S+,? or \S+,?/);
 412             next unless ($match);
 413
 414             $key =~ s/\,/\037\,\037/g;
 415             push(@list, $key);
 416             $val =~ s/,? or /, /g;
 417             &DEBUG("fixed: => $val.");
 418             &setFactInfo($key,"factoid_value", $val);
 419         }
 420         $sth->finish;
 421
 422         # parse the results.
 423         my $prefix = "Inefficient lists fixed ";
 424         return &formListReply(1, $prefix, @list);
 425
 426     } elsif ($type =~ /^locked$/i) {
 427         my %hash = &sqlSelectColhash("factoids",
 428                 "factoid_key,locked_by", { },
 429                 "locked_by IS NOT NULL"
 430         );
 431         my @list = keys %hash;
 432
 433         for (@list) {
 434             s/([\,\;]+)/\037$1\037/g;
 435         }
 436
 437         my $prefix = "factoid statistics on $type ";
 438         return &formListReply(0, $prefix, @list);
 439
 440     } elsif ($type =~ /^new$/i) {
 441         my %hash = &sqlSelectColHash("factoids",
 442                 "factoid_key,created_time", { },
 443                 "created_time IS NOT NULL"
 444         );
 445         my %age;
 446
 447         foreach (keys %hash) {
 448             my $created_time = $hash{$_};
 449             my $delta_time   = time() - $created_time;
 450             next if ($delta_time >= 60*60*24);
 451
 452             $age{$delta_time}{$_} = 1;
 453         }
 454
 455         if (scalar keys %age == 0) {
 456             return "sorry, no new factoids.";
 457         }
 458
 459         my @list;
 460         foreach (sort {$a <=> $b} keys %age) {
 461             push(@list, join(",", keys %{ $age{$_} }));
 462         }
 463
 464         my $prefix = "new factoids in the last 24hours ";
 465         return &formListReply(0, $prefix, @list);
 466
 467     } elsif ($type =~ /^part(ial)?dupe$/i) {
 468         ### requires "custom" select statement... oh well...
 469         my $start_time  = &timeget();
 470
 471         # form length|key and key=length hash list.
 472         &status("factstats(partdupe): forming length hash list.");
 473         my $query = "SELECT factoid_key,factoid_value,length(factoid_value) AS length FROM factoids WHERE length(factoid_value) >= 192 ORDER BY length";
 474         my $sth = $dbh->prepare($query);
 475         &ERROR("factstats(partdupe): => '$query'.") unless $sth->execute;
 476
 477         my (@key, @list);
 478         my (%key, %length);
 479         while (my @row = $sth->fetchrow_array) {
 480             $length{$row[2]}{$row[0]} = 1;      # length(value)|key.
 481             $key{$row[0]} = $row[1];            # key=value.
 482             push(@key, $row[0]);
 483         }
 484         $sth->finish;
 485         &status("factstats(partdupe): total keys => '". scalar(@key) ."'.");
 486         &status("factstats(partdupe): now deciphering data gathered");
 487
 488         my @length = sort { $a <=> $b } keys %length;
 489         my $key;
 490
 491         foreach $key (@key) {
 492             shift @length if (length $key{$key} == $length[0]);
 493
 494             my $val = quotemeta $key{$key};
 495             my @sublist;
 496             my $length;
 497             foreach $length (@length) {
 498                 foreach (keys %{ $length{$length} }) {
 499                     if ($key{$_} =~ /^$val/i) {
 500                         s/([\,\;]+)/\037$1\037/g;
 501                         s/( and|and )/\037$1\037/g;
 502                         push(@sublist,$key." and ".$_);
 503                     }
 504                 }
 505             }
 506             push(@list, join(" ,",@sublist)) if (scalar @sublist);
 507         }
 508
 509         my $delta_time = sprintf("%.02fs", &timedelta($start_time) );
 510         &status("factstats(partdupe): $delta_time sec to complete.") if ($delta_time > 0);
 511
 512         # bail out on no results.
 513         if (scalar @list == 0) {
 514             return "no initial partial duplicate factoids... woohoo.";
 515         }
 516
 517         # parse the results.
 518         my $prefix = "initial partial dupe factoid ";
 519         return &formListReply(1, $prefix, @list);
 520
 521     } elsif ($type =~ /^profanity$/i) {
 522         my %data = &sqlSelectColHash("factoids",
 523                 "factoid_key,factoid_value", { },
 524                 "factoid_value IS NOT NULL"
 525         );
 526         my @list;
 527
 528         foreach (keys %data) {
 529             push(@list, $_) if (&hasProfanity($_." ".$data{$_}));
 530         }
 531
 532         # parse the results.
 533         my $prefix = "Profanity in factoids ";
 534         return &formListReply(1, $prefix, @list);
 535
 536     } elsif ($type =~ /^redir(ection)?$/i) {
 537         my @list = &searchTable("factoids", "factoid_key",
 538                         "factoid_value", "^<REPLY> see ");
 539         my %redir;
 540         my $f;
 541
 542         for (@list) {
 543             my $factoid = $_;
 544             my $val = &getFactInfo($factoid, "factoid_value");
 545             if ($val =~ /^<REPLY> see( also)? (.*?)\.?$/i) {
 546                 my $redir       = lc $2;
 547                 my $redirval    = &getFactInfo($redir, "factoid_value");
 548                 if (defined $redirval) {
 549                     $redir{$redir}{$factoid} = 1;
 550                 } else {
 551                     &WARN("factstats(redir): '$factoid' has loose link => '$redir'.");
 552                 }
 553             }
 554         }
 555
 556         my @newlist;
 557         foreach $f (keys %redir) {
 558             my @sublist = keys %{ $redir{$f} };
 559             for (@sublist) {
 560                 s/([\,\;]+)/\037$1\037/g;
 561             }
 562
 563             push(@newlist, "$f => ". join(', ', @sublist));
 564         }
 565
 566         # parse the results.
 567         my $prefix = "Redirections in factoids ";
 568         return &formListReply(1, $prefix, @newlist);
 569
 570     } elsif ($type =~ /^request(ed)?$/i) {
 571         my %hash = &sqlSelectColHash("factoids",
 572                 "factoid_key,requested_count", { },
 573                 "requested_count IS NOT NULL", 1
 574         );
 575
 576         if (!scalar keys %hash) {
 577             return 'sorry, no factoids have been questioned.';
 578         }
 579
 580         my $count;
 581         my @list;
 582         my $total       = 0;
 583         foreach $count (sort {$b <=> $a} keys %hash) {
 584             my @faqtoids = sort keys %{ $hash{$count} };
 585
 586             for (@faqtoids) {
 587                 s/([\,\;]+)/\037$1\037/g;
 588             }
 589             $total      += $count * scalar(@faqtoids);
 590
 591             push(@list, "$count - ". join(", ", @faqtoids));
 592         }
 593         unshift(@list, "\037$total - TOTAL\037");
 594
 595         my $prefix = "factoid statistics on $type ";
 596         return &formListReply(0, $prefix, @list);
 597
 598     } elsif ($type =~ /^reqrate$/i) {
 599         my %hash = &sqlSelectColHash("factoids",
 600                 "factoid_key,(unix_timestamp() - created_time)/requested_count as rate", { },
 601                 "requested_by IS NOT NULL and created_time IS NOT NULL ORDER BY rate LIMIT 15", 1
 602         );
 603
 604         my $rate;
 605         my @list;
 606         my $total       = 0;
 607         my $users       = 0;
 608         foreach $rate (sort { $b <=> $a } keys %hash) {
 609             my $f       = join(", ", sort keys %{ $hash{$rate} });
 610             my $str     = "$f - ".&Time2String($rate);
 611             $str        =~ s/\002//g;
 612             push(@list, $str);
 613         }
 614
 615         my $prefix = "Rank of top factoid rate (time/req): ";
 616         return &formListReply(0, $prefix, @list);
 617
 618     } elsif ($type =~ /^requesters?$/i) {
 619         my %hash = &sqlSelectColHash("factoids",
 620                 "factoid_key,requested_by", { },
 621                 "requested_by IS NOT NULL"
 622         );
 623         my %requester;
 624
 625         foreach (keys %hash) {
 626             my $thisnuh = $hash{$_};
 627
 628             $thisnuh =~ /^(\S+)!\S+@\S+$/;
 629             $requester{lc $1}++;
 630         }
 631
 632         if (!scalar keys %requester) {
 633             return 'sorry, no factoids with requested_by field.';
 634         }
 635
 636         # work-around.
 637         my %count;
 638         foreach (keys %requester) {
 639             $count{ $requester{$_} }{$_} = 1;
 640         }
 641         undef %requester;
 642
 643         my $count;
 644         my @list;
 645         my $total       = 0;
 646         my $users       = 0;
 647         foreach $count (sort { $b <=> $a } keys %count) {
 648             my $requester = join(", ", sort keys %{ $count{$count} });
 649             $total      += $count * scalar(keys %{ $count{$count} });
 650             $users      += scalar(keys %{ $count{$count} });
 651             push(@list, "$count by $requester");
 652         }
 653         unshift(@list, "\037$total TOTAL REQUESTS; $users UNIQUE REQUESTERS\037");
 654         # should not the above value be the same as collected by
 655         # 'requested'? soemthing weird is going on!
 656
 657         my $prefix = "rank of top factoid requesters: ";
 658         return &formListReply(0, $prefix, @list);
 659
 660     } elsif ($type =~ /^seefix$/i) {
 661         my @list = &searchTable("factoids", "factoid_key",
 662                         "factoid_value", "^see ");
 663         my @newlist;
 664         my $fixed = 0;
 665         my %loop;
 666         my $f;
 667
 668         for (@list) {
 669             my $factoid = $_;
 670             my $val = &getFactInfo($factoid, "factoid_value");
 671
 672             next unless ($val =~ /^see( also)? (.*?)\.?$/i);
 673
 674             my $redirf  = lc $2;
 675             my $redir   = &getFactInfo($redirf, "factoid_value");
 676
 677             if ($redirf =~ /^\Q$factoid\W$/i) {
 678                 &delFactoid($factoid);
 679                 $loop{$factoid} = 1;
 680             }
 681
 682             if (defined $redir) {       # good.
 683                 &setFactInfo($factoid,"factoid_value","<REPLY> see $redir");
 684                 $fixed++;
 685             } else {
 686                 push(@newlist, $redirf);
 687             }
 688         }
 689
 690         # parse the results.
 691         &msg($who, "Fixed $fixed factoids.");
 692         &msg($who, "Self looped factoids removed: ".
 693                 sort(keys %loop) ) if (scalar keys %loop);
 694
 695         my $prefix = "Loose link (dead) redirections in factoids ";
 696         return &formListReply(1, $prefix, @newlist);
 697
 698     } elsif ($type =~ /^(2|too)long$/i) {
 699         my @list;
 700         my $query;
 701
 702         # factoid_key.
 703         $query = "SELECT factoid_key FROM factoids WHERE length(factoid_key) >= $param{'maxKeySize'}";
 704         my $sth = $dbh->prepare($query);
 705         $sth->execute;
 706         while (my @row = $sth->fetchrow_array) {
 707             push(@list,$row[0]);
 708         }
 709         $sth->finish;
 710
 711         # factoid_value.
 712         $query = "SELECT factoid_key,factoid_value FROM factoids WHERE length(factoid_value) >= $param{'maxDataSize'}";
 713         $sth = $dbh->prepare($query);
 714         $sth->execute;
 715         while (my @row = $sth->fetchrow_array) {
 716             push(@list,sprintf("\002%s\002 - %s", length($row[1]), $row[0]));
 717         }
 718         $sth->finish;
 719
 720         if (scalar @list == 0) {
 721             return "good. no factoids exceed length.";
 722         }
 723
 724         # parse the results.
 725         my $prefix = "factoid key||value exceeding length ";
 726         return &formListReply(1, $prefix, @list);
 727
 728     } elsif ($type =~ /^unrequest(ed)?$/i) {
 729         # todo: use sqlSelect()
 730         my @list = &sqlRawReturn("SELECT factoid_key FROM factoids WHERE requested_count IS NULL");
 731
 732         for (@list) {
 733             s/([\,\;]+)/\037$1\037/g;
 734         }
 735
 736         my $prefix = "Unrequested factoids ";
 737         return &formListReply(0, $prefix, @list);
 738     }
 739
 740     return "error: invalid type => '$type'.";
 741 }
 742
 743 sub CmdListAuth {
 744     my ($query) = @_;
 745     my @list = &searchTable("factoids","factoid_key", "created_by", "^$query!");
 746
 747     my $prefix = "factoid author list by '$query' ";
 748     &performStrictReply( &formListReply(1, $prefix, @list) );
 749 }
 750
 751 1;