# rhs - factoid message.
##
-if (&IsParam("useStrict")) { use strict; }
+# use strict; # TODO
use vars qw($msgType $uh $lastWho $ident);
use vars qw(%lang %lastWho);
sub getReply {
my($message) = @_;
my($lhs,$mhs,$rhs);
- my($result,$reply);
- my $literal = 0;
+ my($reply);
$orig{message} = $message;
if (!defined $message or $message =~ /^\s*$/) {
}
$message =~ tr/A-Z/a-z/;
+ $message =~ s/^cmd:/CMD:/;
- if ($result = &getFactoid($message)) {
+ my ($count, $fauthor, $result) = &sqlSelect("factoids",
+ "requested_count,created_by,factoid_value",
+ { factoid_key => $message }
+ );
+
+ if ($result) {
$lhs = $message;
$mhs = "is";
$rhs = $result;
+
+ return "$lhs $mhs $rhs" if ($literal);
} else {
return '';
}
$poss[0] =~ s/^\s//;
$poss[$#poss] =~ s/\s$//;
- if ((@poss > 1) && ($msgType =~ /public/)) {
+ if (@poss > 1) {
$result = &getRandom(@poss);
$result =~ s/^\s*//;
}
- my $fauthor = &dbGet("factoids", "factoid_key", $message, "created_by");
- ### we need non-evaluating regex like in factoid sar.
- if ($msgType =~ /^private$/) {
- if (defined $fauthor and $fauthor =~ /^\Q$who\E\!/i) {
- &status("Reply.pl: author requested own factoid in private; literal!");
- $literal = 1;
- }
- } else {
- my $done = 0;
-
- # (blah1|blah2)?
- while ($result =~ /\((.*?)\)\?/) {
- my $str = $1;
- if (rand() > 0.5) { # fix.
- &status("Factoid transform: keeping '$str'.");
- $result =~ s/\(\Q$str\E\)\?/$str/;
- } else { # remove
- &status("Factoid transform: removing '$str'.");
- $result =~ s/\(\Q$str\E\)\?\s?//;
- }
- $done++;
- last if ($done >= 10); # just in case.
- }
- $done = 0;
-
- # EG: (0-32768) => 6325
- ### TODO: (1-10,20-30,40) => 24
- while ($result =~ /\((\d+)-(\d+)\)/) {
- my ($lower,$upper) = ($1,$2);
- my $new = int(rand $upper-$lower) + $lower;
-
- &status("Reply.pl: SARing '$&' to '$new'.");
- $result =~ s/$&/$new/;
- $done++;
- last if ($done >= 10); # just in case.
- }
- $done = 0;
-
- # EG: (blah1|blah2|blah3|) => blah1
- while ($result =~ /.*\((.*\|.*?)\).*/) {
- $result = &smart_replace($result);
+ $result = &SARit($result);
- $done++;
- last if ($done >= 10); # just in case.
- }
- &status("Reply.pl: $done SARs done.") if ($done);
- }
-
- $reply = $result;
+ $reply = $result;
if ($result ne "") {
### AT LAST, REPEAT PREVENTION CODE REMOVED IN FAVOUR OF GLOBAL
### FLOOD REPETION AND PROTECTION. -20000124
# stats code.
- &setFactInfo($lhs,"requested_by", $nuh);
- &setFactInfo($lhs,"requested_time", time());
### FIXME: old mysql doesn't support
- ### "requested_count=requested_count+1".
- my $count = &getFactInfo($lhs,"requested_count") || 0;
+ ### "requested_count=requested_count+1".
$count++;
- &setFactInfo($lhs,"requested_count", $count);
+ &sqlSet("factoids", {'factoid_key' => $lhs}, {
+ requested_by => $nuh,
+ requested_time => time(),
+ requested_count => $count
+ } );
+ # todo: rename $real to something else!
my $real = 0;
- my $author = &getFactInfo($lhs,"created_by") || '';
-
- $real++ if ($author =~ /^\Q$who\E\!/);
- $real++ if (&IsFlag("n"));
+# my $author = &getFactInfo($lhs,"created_by") || '';
+# $real++ if ($author =~ /^\Q$who\E\!/);
+# $real++ if (&IsFlag("n"));
$real = 0 if ($msgType =~ /public/);
### fix up the reply.
if (!$real and $reply =~ s/^\s*<reply>\s*//i) {
# 'are' fix.
if ($reply =~ s/^are /$lhs are /i) {
- &DEBUG("Reply.pl: el-cheapo 'are' fix executed.");
- $mhs = "are"; # what's this for?
+ &VERB("Reply.pl: el-cheapo 'are' fix executed.",2);
}
} elsif (!$real and $reply =~ s/^\s*<action>\s*(.*)/\cAACTION $1\cA/i) {
# result is random if separated by '||'.
# rhs is full factoid with '||'.
if ($mhs eq "is") {
- $reply = &getRandom(keys %{$lang{'factoid'}});
+ $reply = &getRandom(keys %{ $lang{'factoid'} });
$reply =~ s/##KEY/$lhs/;
$reply =~ s/##VALUE/$result/;
} else {
###
### $ SUBSTITUTION.
###
-
+
+ # don't evaluate if it has factoid arguments.
+ if ($message =~ /^CMD:/i) {
+ &status("Reply: not doing substVars (eval dollar vars)");
+ } else {
+ $reply = &substVars($reply,1);
+ }
+
+ $reply;
+}
+
+sub smart_replace {
+ my ($string) = @_;
+ my ($l,$r) = (0,0); # l = left, r = right.
+ my ($s,$t) = (0,0); # s = start, t = marker.
+ my $i = 0;
+ my $old = $string;
+ my @rand;
+
+ foreach (split //, $string) {
+
+ if ($_ eq "(") {
+ if (!$l and !$r) {
+ $s = $i;
+ $t = $i;
+ }
+
+ $l++;
+ $r--;
+ }
+
+ if ($_ eq ")") {
+ $r++;
+ $l--;
+
+ if (!$l and !$r) {
+ my $substr = substr($old,$s,$i-$s+1);
+ push(@rand, substr($old,$t+1,$i-$t-1) );
+
+ my $rand = $rand[rand @rand];
+# &status("SARing '$substr' to '$rand'.");
+ $string =~ s/\Q$substr\E/$rand/;
+ undef @rand;
+ }
+ }
+
+ if ($_ eq "|" and $l+$r== 0 and $l==1) {
+ push(@rand, substr($old,$t+1,$i-$t-1) );
+ $t = $i;
+ }
+
+ $i++;
+ }
+
+ if ($old eq $string) {
+ &WARN("smart_replace: no subst made. (string => $string)");
+ }
+
+ return $string;
+}
+
+sub SARit {
+ my($txt) = @_;
+ my $done = 0;
+
+ # (blah1|blah2)?
+ while ($txt =~ /\((.*?)\)\?/) {
+ my $str = $1;
+ if (rand() > 0.5) { # fix.
+ &status("Factoid transform: keeping '$str'.");
+ $txt =~ s/\(\Q$str\E\)\?/$str/;
+ } else { # remove
+ &status("Factoid transform: removing '$str'.");
+ $txt =~ s/\(\Q$str\E\)\?\s?//;
+ }
+ $done++;
+ last if ($done >= 10); # just in case.
+ }
+ $done = 0;
+
+ # EG: (0-32768) => 6325
+ ### TODO: (1-10,20-30,40) => 24
+ while ($txt =~ /\((\d+)-(\d+)\)/) {
+ my ($lower,$upper) = ($1,$2);
+ my $new = int(rand $upper-$lower) + $lower;
+
+ &status("SARing '$&' to '$new' (2).");
+ $txt =~ s/$&/$new/;
+ $done++;
+ last if ($done >= 10); # just in case.
+ }
+ $done = 0;
+
+ # EG: (blah1|blah2|blah3|) => blah1
+ while ($txt =~ /.*\((.*\|.*?)\).*/) {
+ $txt = &smart_replace($txt);
+
+ $done++;
+ last if ($done >= 10); # just in case.
+ }
+ &status("Reply.pl: $done SARs done.") if ($done);
+
+ return $txt;
+}
+
+sub substVars {
+ my($reply,$flag) = @_;
+
# $date, $time.
- my $date = scalar(localtime());
+ # todo: support localtime.
+ my $date = scalar(gmtime());
$date =~ s/\:\d+(\s+\w+)\s+\d+$/$1/;
$reply =~ s/\$date/$date/gi;
$date =~ s/\w+\s+\w+\s+\d+\s+//;
$reply =~ s/\$time/$date/gi;
# dollar variables.
- $reply =~ s/\$nick/$who/g;
- $reply =~ s/\$who/$who/g; # backward compat.
+ if ($flag) {
+ $reply =~ s/\$nick/$who/g;
+ $reply =~ s/\$who/$who/g; # backward compat.
+ }
+
if ($reply =~ /\$(user(name)?|host)/) {
my ($username, $hostname) = split /\@/, $uh;
$reply =~ s/\$user(name)?/$username/g;
if ($reply =~ /\$rand/) {
my $rand = rand();
- my $randp = int($rand*100);
- $reply =~ s/\$randpercentage/$randp/g; # ???
- # randnick.
+
+ # $randnick.
if ($reply =~ /\$randnick/) {
- my @nicks = keys %{$channels{$chan}{''}};
+ my @nicks = keys %{ $channels{$chan}{''} };
my $randnick = $nicks[ int($rand*$#nicks) ];
- s/\$randnick/$randnick/;
+ $reply =~ s/\$randnick/$randnick/g;
}
- ### TODO: number of digits. 'x.y'
- if ($reply =~ /\$rand(\d+)/) {
- # will this work as it does in C?
- $rand = sprintf("%*f", $1, $rand);
+ # eg: $rand100.3
+ if ($reply =~ /\$rand(\d+)(\.(\d+))?/) {
+ my $max = $1;
+ my $dot = $3 || 0;
+ my $orig = $&;
+ #&DEBUG("dot => $dot, max => $max, rand=>$rand");
+ $rand = sprintf("%.*f", $dot, $rand*$max);
+
+ &DEBUG("swapping $orig to $rand");
+ $reply =~ s/\Q$orig\E/$rand/eg;
+ } else {
+ $reply =~ s/\$rand/$rand/g;
}
- $reply =~ s/\$rand/$rand/g;
}
- $reply =~ s/\$factoid/$lhs/g;
$reply =~ s/\$ident/$ident/g;
if ($reply =~ /\$startTime/) {
- my $time = scalar(localtime $^T);
+ my $time = scalar(gmtime $^T);
$reply =~ s/\$startTime/$time/;
}
}
if ($reply =~ /\$factoids/) {
- my $count = &countKeys("factoids");
+ my $factoids = &countKeys("factoids");
$reply =~ s/\$factoids/$factoids/;
}
$reply =~ s/\$memusage/$memusage/;
- $reply;
-}
-
-sub smart_replace {
- my ($string) = @_;
- my ($l,$r) = (0,0); # l = left, r = right.
- my ($s,$t) = (0,0); # s = start, t = marker.
- my $i = 0;
- my @rand;
- my $old = $string;
-
- foreach (split //, $string) {
-
- if ($_ eq "(") {
-### print "( l=>$l, r=>$r\n";
-
- if (!$l and !$r) {
-# print "STARTING at $i\n";
- $s = $i;
- $t = $i;
- }
-
- $l++;
- $r--;
- }
-
- if ($_ eq ")") {
-### print ") l=>$l, r=>$r\n";
-
- $r++;
- $l--;
-
- if (!$l and !$r) {
- my $substr = substr($old,$s,$i-$s+1);
-# print "STOP at $i $substr\n";
- push(@rand, substr($old,$t+1,$i-$t-1) );
-
- my $rand = $rand[rand @rand];
- &status("Reply.pl: SARing '$substr' to '$rand'.");
- $string =~ s/\Q$substr\E/$rand/;
- undef @rand;
- }
- }
-
- if ($_ eq "|" and $l+$r== 0 and $l==1) {
-# print "| at $i (l=>$l,r=>$r)\n";
- push(@rand, substr($old,$t+1,$i-$t-1) );
- $t = $i;
- }
-
- $i++;
- }
-
- if ($old eq $string) {
- &WARN("smart_replace: no subst made.");
- }
-
- return $string;
+ return $reply;
}
-
1;
projects / infobot.git / blobdiff