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 if (&IsParam("useStrict")) { use strict; }
   9
  10 ###
  11 # Usage: &CmdFactInfo($faqtoid, $query);
  12 sub CmdFactInfo {
  13     my ($faqtoid, $query) = (lc $_[0], $_[1]);
  14     my @array;
  15     my $string = "";
  16
  17     if ($faqtoid eq "") {
  18         &help("factinfo");
  19         return $noreply;
  20     }
  21
  22     my $i = 0;
  23     my %factinfo;
  24     my @factinfo = &getFactInfo($faqtoid,"*");
  25     foreach ( &dbGetRowInfo("factoids") ) {
  26         $factinfo{$_} = $factinfo[$i] || '';
  27         $i++;
  28     }
  29
  30     # factoid does not exist.
  31     if (scalar @factinfo <= 1) {
  32         &performReply("there's no such factoid as \002$faqtoid\002");
  33         return $noreply;
  34     }
  35
  36     # created:
  37     if ($factinfo{'created_by'}) {
  38
  39         $factinfo{'created_by'} =~ s/\!/ </;
  40         $factinfo{'created_by'} .= ">";
  41         $string  = "created by $factinfo{'created_by'}";
  42
  43         my $time = $factinfo{'created_time'};
  44         if ($time) {
  45             if (time() - $time > 60*60*24*7) {
  46                 my $days = int( (time() - $time)*60*60*24 );
  47                 $string .= " at \037". scalar(localtime $time). "\037" .
  48                                 " ($days days) ";
  49             } else {
  50                 $string .= " ".&Time2String(time() - $time)." ago";
  51             }
  52         }
  53
  54         push(@array,$string);
  55     }
  56
  57     # modified:
  58 #    if ($factinfo{'modified_by'}) {
  59 #       $string = "last modified";
  60 #
  61 #       my $time = $factinfo{'modified_time'};
  62 #       if ($time) {
  63 #           if (time() - $time > 60*60*24*7) {
  64 #               $string .= " at \037". scalar(localtime $time). "\037";
  65 #           } else {
  66 #               $string .= " ".&Time2String(time() - $time)." ago";
  67 #           }
  68 #       }
  69 #
  70 #       my @x;
  71 #       foreach (split ",", $factinfo{'modified_by'}) {
  72 #           /\!/;
  73 #           push(@x, $`);
  74 #       }
  75 #       $string .= "by ".&IJoin(@x);
  76 #
  77 #       $i++;
  78 #       push(@array,$string);
  79 #    }
  80
  81     # requested:
  82     if ($factinfo{'requested_by'}) {
  83         my $requested_count = $factinfo{'requested_count'};
  84
  85         if ($requested_count) {
  86             $string  = "it has been requested ";
  87             if ($requested_count == 1) {
  88                 $string .= "\002once\002";
  89             } else {
  90                 $string .= "\002". $requested_count. "\002 ".
  91                         &fixPlural("time", $requested_count);
  92             }
  93         }
  94
  95         $string .= ", " if ($string ne "");
  96
  97         my $requested_by = $factinfo{'requested_by'};
  98         $requested_by =~ /\!/;
  99         $string .= "last by $`";
 100
 101         my $requested_time = $factinfo{'requested_time'};
 102         if ($requested_time) {
 103             if (time() - $requested_time > 60*60*24*7) {
 104                 $string .= " at \037". scalar(localtime $requested_time). "\037";
 105             } else {
 106                 $string .= ", ".&Time2String(time() - $requested_time)." ago";
 107             }
 108         }
 109
 110         push(@array,$string);
 111     }
 112
 113     # locked:
 114     if ($factinfo{'locked_by'}) {
 115         $factinfo{'locked_by'} =~ /\!/;
 116         $string = "it has been locked by $`";
 117
 118         push(@array, $string);
 119     }
 120
 121     # factoid was inserted not through the bot.
 122     if (!scalar @array) {
 123         &performReply("no extra info on \002$faqtoid\002");
 124         return $noreply;
 125     }
 126
 127     &performStrictReply("$factinfo{'factoid_key'} -- ". join("; ", @array) .".");
 128     return $noreply;
 129 }
 130
 131 sub CmdFactStats {
 132     my ($type) = @_;
 133
 134     if ($type =~ /^author$/i) {
 135         my %hash = &dbGetCol("factoids", "factoid_key","created_by");
 136         my %author;
 137
 138         foreach (keys %hash) {
 139             my $thisnuh = $hash{$_};
 140
 141             $thisnuh =~ /^(\S+)!\S+@\S+$/;
 142             $author{lc $1}++;
 143         }
 144
 145         if (!scalar keys %author) {
 146             return 'sorry, no factoids with created_by field.';
 147         }
 148
 149         # work-around.
 150         my %count;
 151         foreach (keys %author) {
 152             $count{ $author{$_} }{$_} = 1;
 153         }
 154         undef %author;
 155
 156         my $count;
 157         my @list;
 158         foreach $count (sort { $b <=> $a } keys %count) {
 159             my $author = join(", ", sort keys %{$count{$count}});
 160             push(@list, "$count by $author");
 161         }
 162
 163         my $prefix = "factoid statistics by author: ";
 164         return &formListReply(0, $prefix, @list);
 165
 166     } elsif ($type =~ /^broken$/i) {
 167         &status("factstats(broken): starting...");
 168         my $start_time = &gettimeofday();
 169         my %data = &dbGetCol("factoids", "factoid_key","factoid_value");
 170         my @list;
 171
 172         my $delta_time = &gettimeofday() - $start_time;
 173         &status(sprintf("factstats(broken): %.02f sec to retreive all factoids.", $delta_time)) if ($delta_time > 0);
 174         $start_time = &gettimeofday();
 175
 176         # parse the factoids.
 177         foreach (keys %data) {
 178             if (&validFactoid($_, $data{$_}) == 0) {
 179                 s/([\,\;]+)/\037$1\037/g;       # highlight chars.
 180                 push(@list, $_);                # push it.
 181             }
 182         }
 183
 184         $delta_time = &gettimeofday() - $start_time;
 185         &status(sprintf("factstats(broken): %.02f sec to complete.", $delta_time)) if ($delta_time > 0);
 186
 187         # bail out on no results.
 188         if (scalar @list == 0) {
 189             return 'no broken factoids... wooohoo.';
 190         }
 191
 192         # parse the results.
 193         my $prefix = "broken factoid ";
 194         return &formListReply(1, $prefix, @list);
 195
 196     } elsif ($type =~ /^deadredir$/i) {
 197         my @list = &searchTable("factoids", "factoid_key",
 198                         "factoid_value", "^<REPLY> see ");
 199         my %redir;
 200         my $f;
 201
 202         for (@list) {
 203             my $factoid = $_;
 204             my $val = &getFactInfo($factoid, "factoid_value");
 205             if ($val =~ /^<REPLY> see( also)? (.*?)\.?$/i) {
 206                 my $redirf = lc $2;
 207                 my $redir = &getFactInfo($redirf, "factoid_value");
 208                 next if (defined $redir);
 209                 next if (length $val > 50);
 210
 211                 $redir{$redirf}{$factoid} = 1;
 212             }
 213         }
 214
 215         my @newlist;
 216         foreach $f (keys %redir) {
 217             my @sublist = keys %{$redir{$f}};
 218             for (@sublist) {
 219                 s/([\,\;]+)/\037$1\037/g;
 220             }
 221
 222             push(@newlist, join(', ', @sublist)." => $f");
 223         }
 224
 225         # parse the results.
 226         my $prefix = "Loose link (dead) redirections in factoids ";
 227         return &formListReply(1, $prefix, @newlist);
 228
 229     } elsif ($type =~ /^dup(licate|e)$/i) {
 230         my $start_time = &gettimeofday();
 231         &status("factstats(dupe): starting...");
 232         my %hash = &dbGetCol("factoids", "factoid_key", "factoid_value", 1);
 233         my @list;
 234         my $refs = 0;
 235         my $v;
 236
 237         foreach $v (keys %hash) {
 238             my $count = scalar(keys %{$hash{$v}});
 239             next if ($count == 1);
 240
 241             my @sublist;
 242             foreach (keys %{$hash{$v}}) {
 243                 if ($v =~ /^<REPLY> see /i) {
 244                     $refs++;
 245                     next;
 246                 }
 247
 248                 s/([\,\;]+)/\037$1\037/g;
 249                 if ($_ eq "") {
 250                     &WARN("dupe: _ = NULL. should never happen!.");
 251                     next;
 252                 }
 253                 push(@sublist, $_);
 254             }
 255
 256             next unless (scalar @sublist);
 257
 258             push(@list, join(", ", @sublist));
 259         }
 260
 261         &status("factstats(dupe): (good) dupe refs: $refs.");
 262         my $delta_time = &gettimeofday() - $start_time;
 263         &status(sprintf("factstats(dupe): %.02f sec to complete", $delta_time)) if ($delta_time > 0);
 264
 265         # bail out on no results.
 266         if (scalar @list == 0) {
 267             return "no duplicate factoids... woohoo.";
 268         }
 269
 270         # parse the results.
 271         my $prefix = "dupe factoid ";
 272         return &formListReply(1, $prefix, @list);
 273
 274     } elsif ($type =~ /^(2|too)short$/i) {
 275         # Custom select statement.
 276         my $query = "SELECT factoid_key,factoid_value FROM factoids WHERE length(factoid_value) <= 40";
 277         my $sth = $dbh->prepare($query);
 278         &ERROR("factstats(lame): => '$query'.") unless $sth->execute;
 279
 280         my @list;
 281         while (my @row = $sth->fetchrow_array) {
 282             my($key,$val) = ($row[0], $row[1]);
 283             my $match = 0;
 284             $match++ if ($val =~ /\s{3,}/);
 285             next unless ($match);
 286
 287             $key =~ s/\,/\037\,\037/g;
 288             push(@list, $key);
 289         }
 290         $sth->finish;
 291
 292         # parse the results.
 293         my $prefix = "Lame factoids ";
 294         return &formListReply(1, $prefix, @list);
 295
 296     } elsif ($type =~ /^listfix$/i) {
 297         # Custom select statement.
 298         my $query = "SELECT factoid_key,factoid_value FROM factoids";
 299         my $sth = $dbh->prepare($query);
 300         &ERROR("factstats(listfix): => '$query'.") unless $sth->execute;
 301
 302         my @list;
 303         while (my @row = $sth->fetchrow_array) {
 304             my($key,$val) = ($row[0], $row[1]);
 305             my $match = 0;
 306             $match++ if ($val =~ /\S+,? or \S+,? or \S+,? or \S+,?/);
 307             next unless ($match);
 308
 309             $key =~ s/\,/\037\,\037/g;
 310             push(@list, $key);
 311             $val =~ s/,? or /, /g;
 312             &DEBUG("fixed: => $val.");
 313             &setFactInfo($key,"factoid_value", $val);
 314         }
 315         $sth->finish;
 316
 317         # parse the results.
 318         my $prefix = "Inefficient lists fixed ";
 319         return &formListReply(1, $prefix, @list);
 320
 321     } elsif ($type =~ /^locked$/i) {
 322         my %hash = &dbGetCol("factoids", "factoid_key","locked_by");
 323         my @list = keys %hash;
 324
 325         for (@list) {
 326             s/([\,\;]+)/\037$1\037/g;
 327         }
 328
 329         my $prefix = "factoid statistics on $type ";
 330         return &formListReply(0, $prefix, @list);
 331
 332     } elsif ($type =~ /^new$/i) {
 333         my %hash = &dbGetCol("factoids", "factoid_key","created_time");
 334         my %age;
 335
 336         foreach (keys %hash) {
 337             my $created_time = $hash{$_};
 338             my $delta_time   = time() - $created_time;
 339             next if ($delta_time >= 60*60*24);
 340
 341             $age{$delta_time}{$_} = 1;
 342         }
 343
 344         if (scalar keys %age == 0) {
 345             return "sorry, no new factoids.";
 346         }
 347
 348         my @list;
 349         foreach (sort {$a <=> $b} keys %age) {
 350             push(@list, join(",", keys %{$age{$_}}));
 351         }
 352
 353         my $prefix = "new factoids in the last 24hours ";
 354         return &formListReply(0, $prefix, @list);
 355
 356     } elsif ($type =~ /^part(ial)?dupe$/i) {
 357         ### requires "custom" select statement... oh well...
 358         my $start_time = &gettimeofday();
 359
 360         # form length|key and key=length hash list.
 361         &status("factstats(partdupe): forming length hash list.");
 362         my $query = "SELECT factoid_key,factoid_value,length(factoid_value) AS length FROM factoids WHERE length(factoid_value) >= 192 ORDER BY length";
 363         my $sth = $dbh->prepare($query);
 364         &ERROR("factstats(partdupe): => '$query'.") unless $sth->execute;
 365
 366         my (@key, @list);
 367         my (%key, %length);
 368         while (my @row = $sth->fetchrow_array) {
 369             $length{$row[2]}{$row[0]} = 1;      # length(value)|key.
 370             $key{$row[0]} = $row[1];            # key=value.
 371             push(@key, $row[0]);
 372         }
 373         $sth->finish;
 374         &status("factstats(partdupe): total keys => '". scalar(@key) ."'.");
 375         &status("factstats(partdupe): now deciphering data gathered");
 376
 377         my @length = sort { $a <=> $b } keys %length;
 378         my $key;
 379
 380         foreach $key (@key) {
 381             shift @length if (length $key{$key} == $length[0]);
 382
 383             my $val = quotemeta $key{$key};
 384             my @sublist;
 385             my $length;
 386             foreach $length (@length) {
 387                 foreach (keys %{$length{$length}}) {
 388                     if ($key{$_} =~ /^$val/i) {
 389                         s/([\,\;]+)/\037$1\037/g;
 390                         s/( and|and )/\037$1\037/g;
 391                         push(@sublist,$key." and ".$_);
 392                     }
 393                 }
 394             }
 395             push(@list, join(" ,",@sublist)) if (scalar @sublist);
 396         }
 397
 398         my $delta_time = sprintf("%.02fs", &gettimeofday() - $start_time);
 399         &status("factstats(partdupe): $delta_time sec to complete.") if ($delta_time > 0);
 400
 401         # bail out on no results.
 402         if (scalar @list == 0) {
 403             return "no initial partial duplicate factoids... woohoo.";
 404         }
 405
 406         # parse the results.
 407         my $prefix = "initial partial dupe factoid ";
 408         return &formListReply(1, $prefix, @list);
 409
 410     } elsif ($type =~ /^profanity$/i) {
 411         my %data = &dbGetCol("factoids", "factoid_key","factoid_value");
 412         my @list;
 413
 414         foreach (keys %data) {
 415             push(@list, $_) if (&hasProfanity($_." ".$data{$_}));
 416         }
 417
 418         # parse the results.
 419         my $prefix = "Profanity in factoids ";
 420         return &formListReply(1, $prefix, @list);
 421
 422     } elsif ($type =~ /^redir(ection)?$/i) {
 423         my @list = &searchTable("factoids", "factoid_key",
 424                         "factoid_value", "^<REPLY> see ");
 425         my %redir;
 426         my $f;
 427
 428         for (@list) {
 429             my $factoid = $_;
 430             my $val = &getFactInfo($factoid, "factoid_value");
 431             if ($val =~ /^<REPLY> see( also)? (.*?)\.?$/i) {
 432                 my $redir       = lc $2;
 433                 my $redirval    = &getFactInfo($redir, "factoid_value");
 434                 if (defined $redirval) {
 435                     $redir{$redir}{$factoid} = 1;
 436                 } else {
 437                     &WARN("factstats(redir): '$factoid' has loose link => '$redir'.");
 438                 }
 439             }
 440         }
 441
 442         my @newlist;
 443         foreach $f (keys %redir) {
 444             my @sublist = keys %{$redir{$f}};
 445             for (@sublist) {
 446                 s/([\,\;]+)/\037$1\037/g;
 447             }
 448
 449             push(@newlist, "$f => ". join(', ', @sublist));
 450         }
 451
 452         # parse the results.
 453         my $prefix = "Redirections in factoids ";
 454         return &formListReply(1, $prefix, @newlist);
 455
 456     } elsif ($type =~ /^request(ed)?$/i) {
 457         my %hash = &dbGetCol("factoids", "factoid_key", "requested_count",1);
 458
 459         if (!scalar keys %hash) {
 460             return 'sorry, no factoids have been questioned.';
 461         }
 462
 463         my $count;
 464         my @list;
 465         foreach $count (sort {$b <=> $a} keys %hash) {
 466             my @faqtoids = sort keys %{$hash{$count}};
 467
 468             for (@faqtoids) {
 469                 s/([\,\;]+)/\037$1\037/g;
 470             }
 471
 472             push(@list, "$count - ". join(", ", @faqtoids));
 473         }
 474
 475         my $prefix = "factoid statistics on $type ";
 476         return &formListReply(0, $prefix, @list);
 477
 478     } elsif ($type =~ /^requesters?$/i) {
 479         my %hash = &dbGetCol("factoids", "factoid_key","requested_by");
 480         my %requester;
 481
 482         foreach (keys %hash) {
 483             my $thisnuh = $hash{$_};
 484
 485             $thisnuh =~ /^(\S+)!\S+@\S+$/;
 486             $requester{lc $1}++;
 487         }
 488
 489         if (!scalar keys %requester) {
 490             return 'sorry, no factoids with requested_by field.';
 491         }
 492
 493         # work-around.
 494         my %count;
 495         foreach (keys %requester) {
 496             $count{$requester{$_}}{$_} = 1;
 497         }
 498         undef %requester;
 499
 500         my $count;
 501         my @list;
 502         foreach $count (sort { $b <=> $a } keys %count) {
 503             my $requester = join(", ", sort keys %{$count{$count}});
 504             push(@list, "$count by $requester");
 505         }
 506
 507         my $prefix = "rank of top factoid requesters: ";
 508         return &formListReply(0, $prefix, @list);
 509
 510     } elsif ($type =~ /^seefix$/i) {
 511         my @list = &searchTable("factoids", "factoid_key",
 512                         "factoid_value", "^see ");
 513         my @newlist;
 514         my $fixed = 0;
 515         my %loop;
 516         my $f;
 517
 518         for (@list) {
 519             my $factoid = $_;
 520             my $val = &getFactInfo($factoid, "factoid_value");
 521             if ($val =~ /^see( also)? (.*?)\.?$/i) {
 522                 my $redirf = lc $2;
 523                 my $redir = &getFactInfo($redirf, "factoid_value");
 524
 525                 if ($redirf =~ /^\Q$factoid\W$/i) {
 526                     &delFactoid($factoid);
 527                     $loop{$factoid} = 1;
 528                 }
 529
 530                 if (defined $redir) {   # good.
 531                     &setFactInfo($factoid,"factoid_value","<REPLY> see $redir");
 532                     $fixed++;
 533                 } else {
 534                     push(@newlist, $redirf);
 535                 }
 536             }
 537         }
 538
 539         # parse the results.
 540         &msg($who, "Fixed $fixed factoids.");
 541         &msg($who, "Self looped factoids removed: ".
 542                 sort(keys %loop) ) if (scalar keys %loop);
 543
 544         my $prefix = "Loose link (dead) redirections in factoids ";
 545         return &formListReply(1, $prefix, @newlist);
 546
 547     } elsif ($type =~ /^(2|too)long$/i) {
 548         my @list;
 549
 550         # factoid_key.
 551         $query = "SELECT factoid_key FROM factoids WHERE length(factoid_key) >= $param{'maxKeySize'}";
 552         my $sth = $dbh->prepare($query);
 553         $sth->execute;
 554         while (my @row = $sth->fetchrow_array) {
 555             push(@list,$row[0]);
 556         }
 557
 558         # factoid_value.
 559         my $query = "SELECT factoid_key,factoid_value FROM factoids WHERE length(factoid_value) >= $param{'maxDataSize'}";
 560         $sth = $dbh->prepare($query);
 561         $sth->execute;
 562         while (my @row = $sth->fetchrow_array) {
 563             push(@list,sprintf("\002%s\002 - %s", length($row[1]), $row[0]));
 564         }
 565
 566         if (scalar @list == 0) {
 567             return "good. no factoids exceed length.";
 568         }
 569
 570         # parse the results.
 571         my $prefix = "factoid key||value exceeding length ";
 572         return &formListReply(1, $prefix, @list);
 573
 574     } elsif ($type =~ /^unrequest(ed)?$/i) {
 575         my @list = &dbRawReturn("SELECT factoid_key FROM factoids WHERE requested_count IS NULL");
 576
 577         for (@list) {
 578             s/([\,\;]+)/\037$1\037/g;
 579         }
 580
 581         my $prefix = "Unrequested factoids ";
 582         return &formListReply(0, $prefix, @list);
 583     }
 584
 585     return "error: invalid type => '$type'.";
 586 }
 587
 588 sub CmdListAuth {
 589     my ($query) = @_;
 590     my @list = &searchTable("factoids","factoid_key", "created_by", "^$query!");
 591
 592     my $prefix = "factoid author list by '$query' ";
 593     &performStrictReply( &formListReply(1, $prefix, @list) );
 594 }
 595
 596 1;