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