src/Factoids/Reply.pl

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