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