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