src/Factoids/Reply.pl

   1 ###
   2 ### Reply.pl: Kevin Lenzo   (c) 1997
   3 ###
   4
   5 ##
   6 # x is y === $lhs $mhs $rhs
   7 #
   8 #   lhs - factoid.
   9 #   mhs - verb.
  10 #   rhs - factoid message.
  11 ##
  12
  13 # use strict;   # TODO
  14
  15 use vars qw($msgType $uh $lastWho $ident);
  16 use vars qw(%lang %lastWho);
  17
  18 sub getReply {
  19     my($message) = @_;
  20     my($lhs,$mhs,$rhs);
  21     my($reply, $count, $fauthor, $result, $factoid, $search, @searches);
  22     $orig{message} = $message;
  23
  24     if (!defined $message or $message =~ /^\s*$/) {
  25         &WARN("getR: message == NULL.");
  26         return '';
  27     }
  28
  29     $message =~ tr/A-Z/a-z/;
  30
  31     @searches = split(/\s+/, &getChanConfDefault('factoidSearch', '_default'));
  32
  33     # requesting the _default one, ignore factoidSearch
  34     if ($message =~ /^_default\s+/) {
  35         @searches = ('_default');
  36         $message =~ s/^_default\s+//;
  37     }
  38
  39     # check for factoids with each prefix
  40     foreach $search (@searches) {
  41         if ($search eq '$chan') {
  42             $factoid = "$chan $message";
  43         } elsif ($search eq '_default') {
  44             $factoid = $message;
  45         } else {
  46             $factoid = "$search $message";
  47         }
  48         ($count, $fauthor, $result) = &sqlSelect("factoids",
  49             "requested_count,created_by,factoid_value",
  50             { factoid_key => $factoid }
  51         );
  52         last if ($result);
  53     }
  54
  55     if ($result) {
  56         $lhs = $message;
  57         $mhs = "is";
  58         $rhs = $result;
  59
  60         return "\"$factoid\" $mhs \"$rhs\"" if ($literal);
  61     } else {
  62         return '';
  63     }
  64
  65     # if there was a head...
  66     my(@poss) = split '\|\|', $result;
  67     $poss[0] =~ s/^\s//;
  68     $poss[$#poss] =~ s/\s$//;
  69
  70     if (@poss > 1) {
  71         $result = &getRandom(@poss);
  72         $result =~ s/^\s*//;
  73     }
  74
  75     $result     = &SARit($result);
  76
  77     $reply      = $result;
  78     if ($result ne "") {
  79         ### AT LAST, REPEAT PREVENTION CODE REMOVED IN FAVOUR OF GLOBAL
  80         ### FLOOD REPETION AND PROTECTION. -20000124
  81
  82         # stats code.
  83         ### FIXME: old mysql doesn't support
  84         ### "requested_count=requested_count+1".
  85         $count++;
  86         &sqlSet("factoids", {'factoid_key' => $factoid}, {
  87                 requested_by    => $nuh,
  88                 requested_time  => time(),
  89                 requested_count => $count
  90         } );
  91
  92         # TODO: rename $real to something else!
  93         my $real   = 0;
  94 #       my $author = &getFactInfo($lhs,"created_by") || '';
  95 #       $real++ if ($author =~ /^\Q$who\E\!/);
  96 #       $real++ if (&IsFlag("n"));
  97         $real = 0 if ($msgType =~ /public/);
  98
  99         ### fix up the reply.
 100         # only remove '<reply>'
 101         if (!$real and $reply =~ s/^\s*<reply>\s*//i) {
 102             # 'are' fix.
 103             if ($reply =~ s/^are /$lhs are /i) {
 104                 &VERB("Reply.pl: el-cheapo 'are' fix executed.",2);
 105             }
 106
 107         } elsif (!$real and $reply =~ s/^\s*<action>\s*(.*)/\cAACTION $1\cA/i) {
 108             # only remove '<action>' and make it an action.
 109         } else {                # not a short reply
 110
 111             ### bot->bot reply.
 112             if (exists $bots{$nuh} and $rhs !~ /^\s*$/) {
 113                 return "$lhs $mhs $rhs";
 114             }
 115
 116             ### bot->person reply.
 117             # result is random if separated by '||'.
 118             # rhs is full factoid with '||'.
 119             if ($mhs eq "is") {
 120                 $reply = &getRandom(keys %{ $lang{'factoid'} });
 121                 $reply =~ s/##KEY/$lhs/;
 122                 $reply =~ s/##VALUE/$result/;
 123             } else {
 124                 $reply = "$lhs $mhs $result";
 125             }
 126
 127             if ($reply =~ s/^\Q$who\E is/you are/i) {
 128                 # fix the person.
 129             } else {
 130                 if ($reply =~ /^you are / or $reply =~ / you are /) {
 131                     return if ($addressed);
 132                 }
 133             }
 134         }
 135     }
 136
 137     # remove excessive beginning and end whitespaces.
 138     $reply      =~ s/^\s+|\s+$//g;
 139
 140     if ($reply =~ /^\s+$/) {
 141         &DEBUG("Reply: Null factoid ($message)");
 142         return '';
 143     }
 144
 145     return $reply unless ($reply =~ /\$/);
 146
 147     ###
 148     ### $ SUBSTITUTION.
 149     ###
 150
 151     # don't evaluate if it has factoid arguments.
 152     if ($message =~ /^cmd:/i) {
 153         &status("Reply: not doing substVars (eval dollar vars)");
 154     } else {
 155         $reply = &substVars($reply,1);
 156     }
 157
 158     $reply;
 159 }
 160
 161 sub smart_replace {
 162     my ($string) = @_;
 163     my ($l,$r)  = (0,0);        # l = left,  r = right.
 164     my ($s,$t)  = (0,0);        # s = start, t = marker.
 165     my $i       = 0;
 166     my $old     = $string;
 167     my @rand;
 168
 169     foreach (split //, $string) {
 170
 171         if ($_ eq "(") {
 172             if (!$l and !$r) {
 173                 $s = $i;
 174                 $t = $i;
 175             }
 176
 177             $l++;
 178             $r--;
 179         }
 180
 181         if ($_ eq ")") {
 182             $r++;
 183             $l--;
 184
 185             if (!$l and !$r) {
 186                 my $substr = substr($old,$s,$i-$s+1);
 187                 push(@rand, substr($old,$t+1,$i-$t-1) );
 188
 189                 my $rand = $rand[rand @rand];
 190 #               &status("SARing '$substr' to '$rand'.");
 191                 $string =~ s/\Q$substr\E/$rand/;
 192                 undef @rand;
 193             }
 194         }
 195
 196         if ($_ eq "|" and $l+$r== 0 and $l==1) {
 197             push(@rand, substr($old,$t+1,$i-$t-1) );
 198             $t = $i;
 199         }
 200
 201         $i++;
 202     }
 203
 204     if ($old eq $string) {
 205         &WARN("smart_replace: no subst made. (string => $string)");
 206     }
 207
 208     return $string;
 209 }
 210
 211 sub SARit {
 212     my($txt) = @_;
 213     my $done = 0;
 214
 215     # (blah1|blah2)?
 216     while ($txt =~ /\((.*?)\)\?/) {
 217         my $str = $1;
 218         if (rand() > 0.5) {             # fix.
 219             &status("Factoid transform: keeping '$str'.");
 220             $txt =~ s/\(\Q$str\E\)\?/$str/;
 221         } else {                        # remove
 222             &status("Factoid transform: removing '$str'.");
 223             $txt =~ s/\(\Q$str\E\)\?\s?//;
 224         }
 225         $done++;
 226         last if ($done >= 10);  # just in case.
 227     }
 228     $done = 0;
 229
 230     # EG: (0-32768) => 6325
 231     ### TODO: (1-10,20-30,40) => 24
 232     while ($txt =~ /\((\d+)-(\d+)\)/) {
 233         my ($lower,$upper) = ($1,$2);
 234         my $new = int(rand $upper-$lower) + $lower;
 235
 236         &status("SARing '$&' to '$new' (2).");
 237         $txt =~ s/$&/$new/;
 238         $done++;
 239         last if ($done >= 10);  # just in case.
 240     }
 241     $done = 0;
 242
 243     # EG: (blah1|blah2|blah3|) => blah1
 244     while ($txt =~ /.*\((.*\|.*?)\).*/) {
 245         $txt = &smart_replace($txt);
 246
 247         $done++;
 248         last if ($done >= 10);  # just in case.
 249     }
 250     &status("Reply.pl: $done SARs done.") if ($done);
 251
 252     # <URL></URL> type
 253     #
 254     while ($txt =~ /<URL>(.*)<\/URL>/){
 255        &status("we have to norm this <URL></URL> stuff, SARing");
 256        my $foobar = $1;
 257        if ($foobar =~ m/(http:\/\/[^?]+)\?(.*)/){
 258            my ($pig1,$pig2) = ($1,$2);
 259            &status("SARing using URLencode");
 260            $pig2=~s/([^\w])/sprintf("%%%02x",ord($1))/gie;
 261            $foobar=$pig1."?".$pig2;
 262        }
 263        $txt =~ s/<URL>(.*)<\/URL>/$foobar/;
 264     }
 265     return $txt;
 266 }
 267
 268 sub substVars {
 269     my($reply,$flag) = @_;
 270
 271     # $date, $time.
 272     # TODO: support localtime.
 273     my $date    =  scalar(gmtime());
 274     $date       =~ s/\:\d+(\s+\w+)\s+\d+$/$1/;
 275     $reply      =~ s/\$date/$date/gi;
 276     $date       =~ s/\w+\s+\w+\s+\d+\s+//;
 277     $reply      =~ s/\$time/$date/gi;
 278
 279     # dollar variables.
 280     if ($flag) {
 281         $reply  =~ s/\$nick/$who/g;
 282         $reply  =~ s/\$who/$who/g;      # backward compat.
 283     }
 284
 285     if ($reply =~ /\$(user(name)?|host)/) {
 286         my ($username, $hostname) = split /\@/, $uh;
 287         $reply  =~ s/\$user(name)?/$username/g;
 288         $reply  =~ s/\$host(name)?/$hostname/g;
 289     }
 290     $reply      =~ s/\$chan(nel)?/$talkchannel/g;
 291     if ($msgType =~ /public/) {
 292         $reply  =~ s/\$lastspeaker/$lastWho{$talkchannel}/g;
 293     } else {
 294         $reply  =~ s/\$lastspeaker/$lastWho/g;
 295     }
 296
 297     if ($reply =~ /\$rand/) {
 298         my $rand  = rand();
 299
 300         # $randnick.
 301         if ($reply =~ /\$randnick/) {
 302             my @nicks = keys %{ $channels{$chan}{''} };
 303             my $randnick = $nicks[ int($rand*$#nicks) ];
 304             $reply =~ s/\$randnick/$randnick/g;
 305         }
 306
 307         # eg: $rand100.3
 308         if ($reply =~ /\$rand(\d+)(\.(\d+))?/) {
 309             my $max = $1;
 310             my $dot = $3 || 0;
 311             my $orig = $&;
 312             #&DEBUG("dot => $dot, max => $max, rand=>$rand");
 313             $rand = sprintf("%.*f", $dot, $rand*$max);
 314
 315             &DEBUG("swapping $orig to $rand");
 316             $reply =~ s/\Q$orig\E/$rand/eg;
 317         } else {
 318             $reply =~ s/\$rand/$rand/g;
 319         }
 320     }
 321
 322     $reply      =~ s/\$ident/$ident/g;
 323
 324     if ($reply =~ /\$startTime/) {
 325         my $time = scalar(gmtime $^T);
 326         $reply =~ s/\$startTime/$time/;
 327     }
 328
 329     if ($reply =~ /\$uptime/) {
 330         my $uptime = &Time2String(time() - $^T);
 331         $reply =~ s/\$uptime/$uptime/;
 332     }
 333
 334     if ($reply =~ /\$factoids/) {
 335         my $factoids = &countKeys("factoids");
 336         $reply =~ s/\$factoids/$factoids/;
 337     }
 338
 339     if ($reply =~ /\$Fupdate/) {
 340         my $x = "\002$count{'Update'}\002 ".
 341                 &fixPlural("modification", $count{'Update'});
 342         $reply =~ s/\$Fupdate/$x/;
 343     }
 344
 345     if ($reply =~ /\$Fquestion/) {
 346         my $x = "\002$count{'Question'}\002 ".
 347                 &fixPlural("question", $count{'Question'});
 348         $reply =~ s/\$Fquestion/$x/;
 349     }
 350
 351     if ($reply =~ /\$Fdunno/) {
 352         my $x = "\002$count{'Dunno'}\002 ".
 353                 &fixPlural("dunno", $count{'Dunno'});
 354         $reply =~ s/\$Fdunno/$x/;
 355     }
 356
 357     $reply      =~ s/\$memusage/$memusage/;
 358
 359     return $reply;
 360 }
 361
 362 1;