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