2 ### Reply.pl: Kevin Lenzo (c) 1997
6 # x is y === $lhs $mhs $rhs
10 # rhs - factoid message.
13 if (&IsParam("useStrict")) { use strict; }
15 use vars qw($msgType $uh $lastWho $ident);
16 use vars qw(%lang %lastWho);
22 $orig{message} = $message;
24 if (!defined $message or $message =~ /^\s*$/) {
25 &WARN("getR: message == NULL.");
29 $message =~ tr/A-Z/a-z/;
31 my ($result, $fauthor, $count) = &dbGet("factoids",
32 "factoid_value,created_by,requested_count", "factoid_key=".&dbQuote($message) );
38 return "$lhs $mhs $rhs" if ($literal);
43 # if there was a head...
44 my(@poss) = split '\|\|', $result;
46 $poss[$#poss] =~ s/\s$//;
49 $result = &getRandom(@poss);
53 $result = &SARit($result);
57 ### AT LAST, REPEAT PREVENTION CODE REMOVED IN FAVOUR OF GLOBAL
58 ### FLOOD REPETION AND PROTECTION. -20000124
61 ### FIXME: old mysql doesn't support
62 ### "requested_count=requested_count+1".
64 ### BROKEN!!! - Tim Riker <Tim@Rikers.org> says it's fixed now
66 &setFactInfo($lhs,"requested_by", $nuh);
67 &setFactInfo($lhs,"requested_time", time());
68 &setFactInfo($lhs,"requested_count", $count);
70 &dbSet("factoids", {'factoid_key' => $lhs}, {
72 requested_time => time(),
73 requested_count => $count
77 # todo: rename $real to something else!
79 # my $author = &getFactInfo($lhs,"created_by") || '';
80 # $real++ if ($author =~ /^\Q$who\E\!/);
81 # $real++ if (&IsFlag("n"));
82 $real = 0 if ($msgType =~ /public/);
85 # only remove '<reply>'
86 if (!$real and $reply =~ s/^\s*<reply>\s*//i) {
88 if ($reply =~ s/^are /$lhs are /i) {
89 &VERB("Reply.pl: el-cheapo 'are' fix executed.",2);
92 } elsif (!$real and $reply =~ s/^\s*<action>\s*(.*)/\cAACTION $1\cA/i) {
93 # only remove '<action>' and make it an action.
94 } else { # not a short reply
97 if (exists $bots{$nuh} and $rhs !~ /^\s*$/) {
98 return "$lhs $mhs $rhs";
101 ### bot->person reply.
102 # result is random if separated by '||'.
103 # rhs is full factoid with '||'.
105 $reply = &getRandom(keys %{ $lang{'factoid'} });
106 $reply =~ s/##KEY/$lhs/;
107 $reply =~ s/##VALUE/$result/;
109 $reply = "$lhs $mhs $result";
112 if ($reply =~ s/^\Q$who\E is/you are/i) {
115 if ($reply =~ /^you are / or $reply =~ / you are /) {
116 return if ($addressed);
122 return $reply if ($literal);
124 # remove excessive beginning and end whitespaces.
125 $reply =~ s/^\s+|\s+$//g;
127 if ($reply =~ /^\s+$/) {
128 &DEBUG("Reply: Null factoid ($message)");
132 return $reply unless ($reply =~ /\$/);
138 # don't evaluate if it has factoid arguments.
139 if ($message =~ /^CMD:/i) {
140 &status("Reply: not doing substVars (eval dollar vars)");
142 $reply = &substVars($reply,1);
150 my ($l,$r) = (0,0); # l = left, r = right.
151 my ($s,$t) = (0,0); # s = start, t = marker.
156 foreach (split //, $string) {
159 ### print "( l=>$l, r=>$r\n";
162 # print "STARTING at $i\n";
172 ### print ") l=>$l, r=>$r\n";
178 my $substr = substr($old,$s,$i-$s+1);
179 # print "STOP at $i $substr\n";
180 push(@rand, substr($old,$t+1,$i-$t-1) );
182 my $rand = $rand[rand @rand];
183 &status("SARing '$substr' to '$rand'.");
184 $string =~ s/\Q$substr\E/$rand/;
189 if ($_ eq "|" and $l+$r== 0 and $l==1) {
190 # print "| at $i (l=>$l,r=>$r)\n";
191 push(@rand, substr($old,$t+1,$i-$t-1) );
198 if ($old eq $string) {
199 &WARN("smart_replace: no subst made. (string => $string)");
210 while ($txt =~ /\((.*?)\)\?/) {
212 if (rand() > 0.5) { # fix.
213 &status("Factoid transform: keeping '$str'.");
214 $txt =~ s/\(\Q$str\E\)\?/$str/;
216 &status("Factoid transform: removing '$str'.");
217 $txt =~ s/\(\Q$str\E\)\?\s?//;
220 last if ($done >= 10); # just in case.
224 # EG: (0-32768) => 6325
225 ### TODO: (1-10,20-30,40) => 24
226 while ($txt =~ /\((\d+)-(\d+)\)/) {
227 my ($lower,$upper) = ($1,$2);
228 my $new = int(rand $upper-$lower) + $lower;
230 &status("SARing '$&' to '$new' (2).");
233 last if ($done >= 10); # just in case.
237 # EG: (blah1|blah2|blah3|) => blah1
238 while ($txt =~ /.*\((.*\|.*?)\).*/) {
239 $txt = &smart_replace($txt);
242 last if ($done >= 10); # just in case.
244 &status("Reply.pl: $done SARs done.") if ($done);
250 my($reply,$flag) = @_;
253 my $date = scalar(localtime());
254 $date =~ s/\:\d+(\s+\w+)\s+\d+$/$1/;
255 $reply =~ s/\$date/$date/gi;
256 $date =~ s/\w+\s+\w+\s+\d+\s+//;
258 $reply =~ s/\$time/$date/gi;
262 $reply =~ s/\$nick/$who/g;
263 $reply =~ s/\$who/$who/g; # backward compat.
266 if ($reply =~ /\$(user(name)?|host)/) {
267 my ($username, $hostname) = split /\@/, $uh;
268 $reply =~ s/\$user(name)?/$username/g;
269 $reply =~ s/\$host(name)?/$hostname/g;
271 $reply =~ s/\$chan(nel)?/$talkchannel/g;
272 if ($msgType =~ /public/) {
273 $reply =~ s/\$lastspeaker/$lastWho{$talkchannel}/g;
275 $reply =~ s/\$lastspeaker/$lastWho/g;
278 if ($reply =~ /\$rand/) {
282 if ($reply =~ /\$randnick/) {
283 my @nicks = keys %{ $channels{$chan}{''} };
284 my $randnick = $nicks[ int($rand*$#nicks) ];
285 $reply =~ s/\$randnick/$randnick/g;
289 ### TODO: number of digits. 'x.y'
291 if ($reply =~ /\$rand(\d+)(\.(\d+))?/) {
294 &status("dot => $dot, max => $max, rand=>$rand");
295 $rand = sprintf("%.*f", $dot, $rand*$max);
298 &status("swapping $orig to $rand");
299 &status("reply => $reply");
300 $reply =~ s/$orig/$rand/eg;
301 &status("reply => $reply");
304 $reply =~ s/\$rand/$rand/g;
307 $reply =~ s/\$ident/$ident/g;
309 if ($reply =~ /\$startTime/) {
310 my $time = scalar(localtime $^T);
311 $reply =~ s/\$startTime/$time/;
314 if ($reply =~ /\$uptime/) {
315 my $uptime = &Time2String(time() - $^T);
316 $reply =~ s/\$uptime/$uptime/;
319 if ($reply =~ /\$factoids/) {
320 my $count = &countKeys("factoids");
321 $reply =~ s/\$factoids/$factoids/;
324 if ($reply =~ /\$Fupdate/) {
325 my $x = "\002$count{'Update'}\002 ".
326 &fixPlural("modification", $count{'Update'});
327 $reply =~ s/\$Fupdate/$x/;
330 if ($reply =~ /\$Fquestion/) {
331 my $x = "\002$count{'Question'}\002 ".
332 &fixPlural("question", $count{'Question'});
333 $reply =~ s/\$Fquestion/$x/;
336 if ($reply =~ /\$Fdunno/) {
337 my $x = "\002$count{'Dunno'}\002 ".
338 &fixPlural("dunno", $count{'Dunno'});
339 $reply =~ s/\$Fdunno/$x/;
342 $reply =~ s/\$memusage/$memusage/;