2 ### Reply.pl: Kevin Lenzo (c) 1997
6 # x is y === $lhs $mhs $rhs
10 # rhs - factoid message.
14 use POSIX qw(strftime);
16 use vars qw($msgType $uh $lastWho $ident);
17 use vars qw(%lang %lastWho);
22 my($reply, $count, $fauthor, $result, $factoid, $search, @searches);
23 $orig{message} = $message;
25 if (!defined $message or $message =~ /^\s*$/) {
26 &WARN("getR: message == NULL.");
30 $message =~ tr/A-Z/a-z/;
32 @searches = split(/\s+/, &getChanConfDefault('factoidSearch', '_default', $chan));
33 &::DEBUG("factoidSearch: $chan is: " . join(':', @searches));
34 # requesting the _default one, ignore factoidSearch
35 if ($message =~ /^_default\s+/) {
36 @searches = ('_default');
37 $message =~ s/^_default\s+//;
40 # check for factoids with each prefix
41 foreach $search (@searches) {
42 if ($search eq '$chan') {
43 $factoid = "$chan $message";
44 } elsif ($search eq '_default') {
47 $factoid = "$search $message";
49 ($count, $fauthor, $result) = &sqlSelect("factoids",
50 "requested_count,created_by,factoid_value",
51 { factoid_key => $factoid }
61 return "\"$factoid\" $mhs \"$rhs\"" if ($literal);
66 # if there was a head...
67 my(@poss) = split '\|\|', $result;
69 $poss[$#poss] =~ s/\s$//;
72 $result = &getRandom(@poss);
76 $result = &SARit($result);
80 ### AT LAST, REPEAT PREVENTION CODE REMOVED IN FAVOUR OF GLOBAL
81 ### FLOOD REPETION AND PROTECTION. -20000124
84 ### FIXME: old mysql/sqlite doesn't support
85 ### "requested_count=requested_count+1".
87 &sqlSet("factoids", {'factoid_key' => $factoid}, {
89 requested_time => time(),
90 requested_count => $count
93 # TODO: rename $real to something else!
95 # my $author = &getFactInfo($lhs,"created_by") || '';
96 # $real++ if ($author =~ /^\Q$who\E\!/);
97 # $real++ if (&IsFlag("n"));
98 $real = 0 if ($msgType =~ /public/);
100 ### fix up the reply.
101 # only remove '<reply>'
102 if (!$real and $reply =~ s/^\s*<reply>\s*//i) {
104 if ($reply =~ s/^are /$lhs are /i) {
105 &VERB("Reply.pl: el-cheapo 'are' fix executed.",2);
108 } elsif (!$real and $reply =~ s/^\s*<action>\s*(.*)/\cAACTION $1\cA/i) {
109 # only remove '<action>' and make it an action.
110 } else { # not a short reply
113 if (exists $bots{$nuh} and $rhs !~ /^\s*$/) {
114 return "$lhs $mhs $rhs";
117 ### bot->person reply.
118 # result is random if separated by '||'.
119 # rhs is full factoid with '||'.
121 $reply = &getRandom(keys %{ $lang{'factoid'} });
122 $reply =~ s/##KEY/$lhs/;
123 $reply =~ s/##VALUE/$result/;
125 $reply = "$lhs $mhs $result";
128 $reply =~ s/^\Q$who\E is/you are/i);
132 # remove excessive beginning and end whitespaces.
133 $reply =~ s/^\s+|\s+$//g;
135 if ($reply =~ /^\s+$/) {
136 &DEBUG("Reply: Null factoid ($message)");
140 return $reply unless ($reply =~ /\$/);
146 # don't evaluate if it has factoid arguments.
147 # if ($message =~ /^cmd:/i) {
148 # &status("Reply: not doing substVars (eval dollar vars)");
150 $reply = &substVars($reply,1);
158 my ($l,$r) = (0,0); # l = left, r = right.
159 my ($s,$t) = (0,0); # s = start, t = marker.
164 foreach (split //, $string) {
181 my $substr = substr($old,$s,$i-$s+1);
182 push(@rand, substr($old,$t+1,$i-$t-1) );
184 my $rand = $rand[rand @rand];
185 # &status("SARing '$substr' to '$rand'.");
186 $string =~ s/\Q$substr\E/$rand/;
191 if ($_ eq "|" and $l+$r== 0 and $l==1) {
192 push(@rand, substr($old,$t+1,$i-$t-1) );
199 if ($old eq $string) {
200 &WARN("smart_replace: no subst made. (string => $string)");
211 while ($txt =~ /\((.*?)\)\?/) {
213 if (rand() > 0.5) { # fix.
214 &status("Factoid transform: keeping '$str'.");
215 $txt =~ s/\(\Q$str\E\)\?/$str/;
217 &status("Factoid transform: removing '$str'.");
218 $txt =~ s/\(\Q$str\E\)\?\s?//;
221 last if ($done >= 10); # just in case.
225 # EG: (0-32768) => 6325
226 ### TODO: (1-10,20-30,40) => 24
227 while ($txt =~ /\((\d+)-(\d+)\)/) {
228 my ($lower,$upper) = ($1,$2);
229 my $new = int(rand $upper-$lower) + $lower;
231 &status("SARing '$&' to '$new' (2).");
234 last if ($done >= 10); # just in case.
238 # EG: (blah1|blah2|blah3|) => blah1
239 while ($txt =~ /.*\((.*\|.*?)\).*/) {
240 $txt = &smart_replace($txt);
243 last if ($done >= 10); # just in case.
245 &status("Reply.pl: $done SARs done.") if ($done);
249 while ($txt =~ /<URL>(.*)<\/URL>/){
250 &status("we have to norm this <URL></URL> stuff, SARing");
252 if ($foobar =~ m/(http:\/\/[^?]+)\?(.*)/){
253 my ($pig1,$pig2) = ($1,$2);
254 &status("SARing using URLencode");
255 $pig2=~s/([^\w])/sprintf("%%%02x",ord($1))/gie;
256 $foobar=$pig1."?".$pig2;
258 $txt =~ s/<URL>(.*)<\/URL>/$foobar/;
264 my($reply,$flag) = @_;
266 # $date, $time, $day.
267 # TODO: support localtime.
268 my $date = strftime("%Y.%m.%d", gmtime());
269 $reply =~ s/\$date/$date/gi;
270 my $time = strftime("%k:%M:%S", gmtime());
271 $reply =~ s/\$time/$time/gi;
272 my $day = strftime("%A", gmtime());
273 $reply =~ s/\$day/$day/gi;
275 # support $ident when I have multiple nicks
276 my $mynick = $conn->nick() if $conn;
280 $reply =~ s/\$nick/$who/g;
281 $reply =~ s/\$who/$who/g; # backward compat.
284 if ($reply =~ /\$(user(name)?|host)/) {
285 my ($username, $hostname) = split /\@/, $uh;
286 $reply =~ s/\$user(name)?/$username/g;
287 $reply =~ s/\$host(name)?/$hostname/g;
289 $reply =~ s/\$chan(nel)?/$talkchannel/g;
290 if ($msgType =~ /public/) {
291 $reply =~ s/\$lastspeaker/$lastWho{$talkchannel}/g;
293 $reply =~ s/\$lastspeaker/$lastWho/g;
296 if ($reply =~ /\$rand/) {
300 if ($reply =~ /\$randnick/) {
301 my @nicks = keys %{ $channels{$chan}{''} };
302 my $randnick = $nicks[ int($rand*$#nicks) ];
303 $reply =~ s/\$randnick/$randnick/g;
307 if ($reply =~ /\$rand(\d+)(\.(\d+))?/) {
311 #&DEBUG("dot => $dot, max => $max, rand=>$rand");
312 $rand = sprintf("%.*f", $dot, $rand*$max);
314 &DEBUG("swapping $orig to $rand");
315 $reply =~ s/\Q$orig\E/$rand/eg;
317 $reply =~ s/\$rand/$rand/g;
321 $reply =~ s/\$ident/$mynick/g;
323 if ($reply =~ /\$startTime/) {
324 my $time = scalar(gmtime $^T);
325 $reply =~ s/\$startTime/$time/;
328 if ($reply =~ /\$uptime/) {
329 my $uptime = &Time2String(time() - $^T);
330 $reply =~ s/\$uptime/$uptime/;
333 if ($reply =~ /\$factoids/) {
334 my $factoids = &countKeys("factoids");
335 $reply =~ s/\$factoids/$factoids/;
338 if ($reply =~ /\$Fupdate/) {
339 my $x = "\002$count{'Update'}\002 ".
340 &fixPlural("modification", $count{'Update'});
341 $reply =~ s/\$Fupdate/$x/;
344 if ($reply =~ /\$Fquestion/) {
345 my $x = "\002$count{'Question'}\002 ".
346 &fixPlural("question", $count{'Question'});
347 $reply =~ s/\$Fquestion/$x/;
350 if ($reply =~ /\$Fdunno/) {
351 my $x = "\002$count{'Dunno'}\002 ".
352 &fixPlural("dunno", $count{'Dunno'});
353 $reply =~ s/\$Fdunno/$x/;
356 $reply =~ s/\$memusage/$memusage/;