src/Modules/Factoids.pl

   1 #
   2 #  Factoids.pl: Helpers for generating factoids statistics.
   3 #       Author: xk <xk@leguin.openprojects.net>
   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
 208                 $redir{$redirf}{$factoid} = 1;
 209             }
 210         }
 211
 212         my @newlist;
 213         foreach $f (keys %redir) {
 214             my @sublist = keys %{$redir{$f}};
 215             for (@sublist) {
 216                 s/([\,\;]+)/\037$1\037/g;
 217             }
 218
 219             push(@newlist, join(', ', @sublist)." => $f");
 220         }
 221
 222         # parse the results.
 223         my $prefix = "Loose link (dead) redirections in factoids ";
 224         return &formListReply(1, $prefix, @newlist);
 225
 226     } elsif ($type =~ /^dup(licate|e)$/i) {
 227         my $start_time = &gettimeofday();
 228         &status("factstats(dupe): starting...");
 229         my %hash = &dbGetCol("factoids", "factoid_key", "factoid_value", 1);
 230         my @list;
 231         my $refs = 0;
 232         my $v;
 233
 234         foreach $v (keys %hash) {
 235             my $count = scalar(keys %{$hash{$v}});
 236             next if ($count == 1);
 237
 238             my @sublist;
 239             foreach (keys %{$hash{$v}}) {
 240                 if ($v =~ /^<REPLY> see /i) {
 241                     $refs++;
 242                     next;
 243                 }
 244
 245                 s/([\,\;]+)/\037$1\037/g;
 246                 if ($_ eq "") {
 247                     &WARN("dupe: _ = NULL. should never happen!.");
 248                     next;
 249                 }
 250                 push(@sublist, $_);
 251             }
 252
 253             next unless (scalar @sublist);
 254
 255             push(@list, join(", ", @sublist));
 256         }
 257
 258         &status("factstats(dupe): (good) dupe refs: $refs.");
 259         my $delta_time = &gettimeofday() - $start_time;
 260         &status(sprintf("factstats(dupe): %.02f sec to complete", $delta_time)) if ($delta_time > 0);
 261
 262         # bail out on no results.
 263         if (scalar @list == 0) {
 264             return "no duplicate factoids... woohoo.";
 265         }
 266
 267         # parse the results.
 268         my $prefix = "dupe factoid ";
 269         return &formListReply(1, $prefix, @list);
 270
 271     } elsif ($type =~ /^lame$/i) {
 272         # Custom select statement.
 273         my $query = "SELECT factoid_key,factoid_value FROM factoids WHERE length(factoid_value) <= 40";
 274         my $sth = $dbh->prepare($query);
 275         &ERROR("factstats(lame): => '$query'.") unless $sth->execute;
 276
 277         my @list;
 278         while (my @row = $sth->fetchrow_array) {
 279             my($key,$val) = ($row[0], $row[1]);
 280             next if ($val =~ /^</);
 281             next if ($val =~ /\s{2,}/);
 282
 283             $key =~ s/\,/\037\,\037/g;
 284             push(@list, $key);
 285         }
 286         $sth->finish;
 287
 288         # parse the results.
 289         my $prefix = "Lame factoids ";
 290         return &formListReply(1, $prefix, @list);
 291
 292     } elsif ($type =~ /^locked$/i) {
 293         my %hash = &dbGetCol("factoids", "factoid_key","locked_by");
 294         my @list = keys %hash;
 295
 296         for (@list) {
 297             s/([\,\;]+)/\037$1\037/g;
 298         }
 299
 300         my $prefix = "factoid statistics on $type ";
 301         return &formListReply(0, $prefix, @list);
 302
 303     } elsif ($type =~ /^new$/i) {
 304         my %hash = &dbGetCol("factoids", "factoid_key","created_time");
 305         my %age;
 306
 307         foreach (keys %hash) {
 308             my $created_time = $hash{$_};
 309             my $delta_time   = time() - $created_time;
 310             next if ($delta_time >= 60*60*24);
 311
 312             $age{$delta_time}{$_} = 1;
 313         }
 314
 315         if (scalar keys %age == 0) {
 316             return "sorry, no new factoids.";
 317         }
 318
 319         my @list;
 320         foreach (sort {$a <=> $b} keys %age) {
 321             push(@list, join(",", keys %{$age{$_}}));
 322         }
 323
 324         my $prefix = "new factoids in the last 24hours ";
 325         return &formListReply(0, $prefix, @list);
 326
 327     } elsif ($type =~ /^part(ial)?dupe$/i) {
 328         ### requires "custom" select statement... oh well...
 329         my $start_time = &gettimeofday();
 330
 331         # form length|key and key=length hash list.
 332         &status("factstats(partdupe): forming length hash list.");
 333         my $query = "SELECT factoid_key,factoid_value,length(factoid_value) AS length FROM factoids WHERE length(factoid_value) >= 192 ORDER BY length";
 334         my $sth = $dbh->prepare($query);
 335         &ERROR("factstats(partdupe): => '$query'.") unless $sth->execute;
 336
 337         my (@key, @list);
 338         my (%key, %length);
 339         while (my @row = $sth->fetchrow_array) {
 340             $length{$row[2]}{$row[0]} = 1;      # length(value)|key.
 341             $key{$row[0]} = $row[1];            # key=value.
 342             push(@key, $row[0]);
 343         }
 344         $sth->finish;
 345         &status("factstats(partdupe): total keys => '". scalar(@key) ."'.");
 346         &status("factstats(partdupe): now deciphering data gathered");
 347
 348         my @length = sort { $a <=> $b } keys %length;
 349         my $key;
 350
 351         foreach $key (@key) {
 352             shift @length if (length $key{$key} == $length[0]);
 353
 354             my $val = quotemeta $key{$key};
 355             my @sublist;
 356             my $length;
 357             foreach $length (@length) {
 358                 foreach (keys %{$length{$length}}) {
 359                     if ($key{$_} =~ /^$val/i) {
 360                         s/([\,\;]+)/\037$1\037/g;
 361                         s/( and|and )/\037$1\037/g;
 362                         push(@sublist,$key." and ".$_);
 363                     }
 364                 }
 365             }
 366             push(@list, join(" ,",@sublist)) if (scalar @sublist);
 367         }
 368
 369         my $delta_time = sprintf("%.02fs", &gettimeofday() - $start_time);
 370         &status("factstats(partdupe): $delta_time sec to complete.") if ($delta_time > 0);
 371
 372         # bail out on no results.
 373         if (scalar @list == 0) {
 374             return "no initial partial duplicate factoids... woohoo.";
 375         }
 376
 377         # parse the results.
 378         my $prefix = "initial partial dupe factoid ";
 379         return &formListReply(1, $prefix, @list);
 380
 381     } elsif ($type =~ /^profanity$/i) {
 382         my %data = &dbGetCol("factoids", "factoid_key","factoid_value");
 383         my @list;
 384
 385         foreach (keys %data) {
 386             push(@list, $_) if (&hasProfanity($_." ".$data{$_}));
 387         }
 388
 389         # parse the results.
 390         my $prefix = "Profanity in factoids ";
 391         return &formListReply(1, $prefix, @list);
 392
 393     } elsif ($type =~ /^redir(ection)?$/i) {
 394         my @list = &searchTable("factoids", "factoid_key",
 395                         "factoid_value", "^<REPLY> see ");
 396         my %redir;
 397         my $f;
 398
 399         for (@list) {
 400             my $factoid = $_;
 401             my $val = &getFactInfo($factoid, "factoid_value");
 402             if ($val =~ /^<REPLY> see( also)? (.*?)\.?$/i) {
 403                 my $redir       = lc $2;
 404                 my $redirval    = &getFactInfo($redir, "factoid_value");
 405                 if (defined $redirval) {
 406                     $redir{$redir}{$factoid} = 1;
 407                 } else {
 408                     &WARN("factstats(redir): '$factoid' has loose link => '$redir'.");
 409                 }
 410             }
 411         }
 412
 413         my @newlist;
 414         foreach $f (keys %redir) {
 415             my @sublist = keys %{$redir{$f}};
 416             for (@sublist) {
 417                 s/([\,\;]+)/\037$1\037/g;
 418             }
 419
 420             push(@newlist, "$f => ". join(', ', @sublist));
 421         }
 422
 423         # parse the results.
 424         my $prefix = "Redirections in factoids ";
 425         return &formListReply(1, $prefix, @newlist);
 426
 427     } elsif ($type =~ /^request(ed)?$/i) {
 428         my %hash = &dbGetCol("factoids", "factoid_key", "requested_count",1);
 429
 430         if (!scalar keys %hash) {
 431             return 'sorry, no factoids have been questioned.';
 432         }
 433
 434         my $count;
 435         my @list;
 436         foreach $count (sort {$b <=> $a} keys %hash) {
 437             my @faqtoids = sort keys %{$hash{$count}};
 438
 439             for (@faqtoids) {
 440                 s/([\,\;]+)/\037$1\037/g;
 441             }
 442
 443             push(@list, "$count - ". join(", ", @faqtoids));
 444         }
 445
 446         my $prefix = "factoid statistics on $type ";
 447         return &formListReply(0, $prefix, @list);
 448
 449     } elsif ($type =~ /^requesters?$/i) {
 450         my %hash = &dbGetCol("factoids", "factoid_key","requested_by");
 451         my %requester;
 452
 453         foreach (keys %hash) {
 454             my $thisnuh = $hash{$_};
 455
 456             $thisnuh =~ /^(\S+)!\S+@\S+$/;
 457             $requester{lc $1}++;
 458         }
 459
 460         if (!scalar keys %requester) {
 461             return 'sorry, no factoids with requested_by field.';
 462         }
 463
 464         # work-around.
 465         my %count;
 466         foreach (keys %requester) {
 467             $count{$requester{$_}}{$_} = 1;
 468         }
 469         undef %requester;
 470
 471         my $count;
 472         my @list;
 473         foreach $count (sort { $b <=> $a } keys %count) {
 474             my $requester = join(", ", sort keys %{$count{$count}});
 475             push(@list, "$count by $requester");
 476         }
 477
 478         my $prefix = "rank of top factoid requesters: ";
 479         return &formListReply(0, $prefix, @list);
 480
 481     } elsif ($type =~ /^(2|too)long$/i) {
 482         my @list;
 483
 484         # factoid_key.
 485         $query = "SELECT factoid_key FROM factoids WHERE length(factoid_key) >= $param{'maxKeySize'}";
 486         my $sth = $dbh->prepare($query);
 487         $sth->execute;
 488         while (my @row = $sth->fetchrow_array) {
 489             push(@list,$row[0]);
 490         }
 491
 492         # factoid_value.
 493         my $query = "SELECT factoid_key,factoid_value FROM factoids WHERE length(factoid_value) >= $param{'maxDataSize'}";
 494         $sth = $dbh->prepare($query);
 495         $sth->execute;
 496         while (my @row = $sth->fetchrow_array) {
 497             push(@list,sprintf("\002%s\002 - %s", length($row[1]), $row[0]));
 498         }
 499
 500         if (scalar @list == 0) {
 501             return "good. no factoids exceed length.";
 502         }
 503
 504         # parse the results.
 505         my $prefix = "factoid key||value exceeding length ";
 506         return &formListReply(1, $prefix, @list);
 507
 508     } elsif ($type =~ /^unrequest(ed)?$/i) {
 509         my @list = &dbRawReturn("SELECT factoid_key FROM factoids WHERE requested_count IS NULL");
 510
 511         for (@list) {
 512             s/([\,\;]+)/\037$1\037/g;
 513         }
 514
 515         my $prefix = "Unrequested factoids ";
 516         return &formListReply(0, $prefix, @list);
 517     }
 518
 519     return "error: invalid type => '$type'.";
 520 }
 521
 522 sub CmdListAuth {
 523     my ($query) = @_;
 524     my @list = &searchTable("factoids","factoid_key", "created_by", "^$query!");
 525
 526     my $prefix = "factoid author list by '$query' ";
 527     return &formListReply(1, $prefix, @list);
 528 }
 529
 530 1;