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