X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=src%2FFactoids%2FReply.pl;h=38f65a083db6d8c534d9716887cdc629c953a236;hb=748d5127824d8a9de7d6fd59d6dbb05607cc107a;hp=1c470c4ca98c1a8584616e20adb273f436c401a8;hpb=0e3df27228cf790fad3c3d9b6496db63c3ece37e;p=infobot.git diff --git a/src/Factoids/Reply.pl b/src/Factoids/Reply.pl index 1c470c4..38f65a0 100644 --- a/src/Factoids/Reply.pl +++ b/src/Factoids/Reply.pl @@ -10,7 +10,8 @@ # rhs - factoid message. ## -if (&IsParam("useStrict")) { use strict; } +# use strict; # TODO +use POSIX qw(strftime); use vars qw($msgType $uh $lastWho $ident); use vars qw(%lang %lastWho); @@ -18,7 +19,7 @@ use vars qw(%lang %lastWho); sub getReply { my($message) = @_; my($lhs,$mhs,$rhs); - my($result,$reply); + my($reply, $count, $fauthor, $result, $factoid, $search, @searches); $orig{message} = $message; if (!defined $message or $message =~ /^\s*$/) { @@ -28,12 +29,36 @@ sub getReply { $message =~ tr/A-Z/a-z/; - if ($result = &getFactoid($message)) { + @searches = split(/\s+/, &getChanConfDefault('factoidSearch', '_default', $chan)); + &::DEBUG("factoidSearch: $chan is: " . join(':', @searches)); + # requesting the _default one, ignore factoidSearch + if ($message =~ /^_default\s+/) { + @searches = ('_default'); + $message =~ s/^_default\s+//; + } + + # check for factoids with each prefix + foreach $search (@searches) { + if ($search eq '$chan') { + $factoid = "$chan $message"; + } elsif ($search eq '_default') { + $factoid = $message; + } else { + $factoid = "$search $message"; + } + ($count, $fauthor, $result) = &sqlSelect("factoids", + "requested_count,created_by,factoid_value", + { factoid_key => $factoid } + ); + last if ($result); + } + + if ($result) { $lhs = $message; $mhs = "is"; $rhs = $result; - return "$lhs $mhs $rhs" if ($literal); + return "\"$factoid\" $mhs \"$rhs\"" if ($literal); } else { return ''; } @@ -43,78 +68,33 @@ sub getReply { $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); - - $done++; - last if ($done >= 10); # just in case. - } - &status("Reply.pl: $done SARs done.") if ($done); - } + $result = &SARit($result); - $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; + ### FIXME: old mysql/sqlite doesn't support + ### "requested_count=requested_count+1". $count++; - &setFactInfo($lhs,"requested_count", $count); + &sqlSet("factoids", {'factoid_key' => $factoid}, { + 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. @@ -122,8 +102,7 @@ sub getReply { if (!$real and $reply =~ s/^\s*\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*\s*(.*)/\cAACTION $1\cA/i) { @@ -146,18 +125,10 @@ sub getReply { $reply = "$lhs $mhs $result"; } - if ($reply =~ s/^\Q$who\E is/you are/i) { - # fix the person. - } else { - if ($reply =~ /^you are / or $reply =~ / you are /) { - return if ($addressed); - } - } + $reply =~ s/^\Q$who\E is/you are/i) { } } - return $reply if ($literal); - # remove excessive beginning and end whitespaces. $reply =~ s/^\s+|\s+$//g; @@ -171,17 +142,145 @@ sub getReply { ### ### $ SUBSTITUTION. ### - - # $date, $time. - my $date = scalar(localtime()); - $date =~ s/\:\d+(\s+\w+)\s+\d+$/$1/; + + # 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); + + # type + # + while ($txt =~ /(.*)<\/URL>/){ + &status("we have to norm this stuff, SARing"); + my $foobar = $1; + if ($foobar =~ m/(http:\/\/[^?]+)\?(.*)/){ + my ($pig1,$pig2) = ($1,$2); + &status("SARing using URLencode"); + $pig2=~s/([^\w])/sprintf("%%%02x",ord($1))/gie; + $foobar=$pig1."?".$pig2; + } + $txt =~ s/(.*)<\/URL>/$foobar/; + } + return $txt; +} + +sub substVars { + my($reply,$flag) = @_; + + # $date, $time, $day. + # TODO: support localtime. + my $date = strftime("%Y.%m.%d", gmtime()); $reply =~ s/\$date/$date/gi; - $date =~ s/\w+\s+\w+\s+\d+\s+//; - $reply =~ s/\$time/$date/gi; + my $time = strftime("%k:%M:%S", gmtime()); + $reply =~ s/\$time/$time/gi; + my $day = strftime("%A", gmtime()); + $reply =~ s/\$day/$day/gi; + + # support $ident when I have multiple nicks + my $mynick = $conn->nick() if $conn; # 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; @@ -196,28 +295,33 @@ sub getReply { 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 $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; + $reply =~ s/\$ident/$mynick/g; if ($reply =~ /\$startTime/) { - my $time = scalar(localtime $^T); + my $time = scalar(gmtime $^T); $reply =~ s/\$startTime/$time/; } @@ -227,7 +331,7 @@ sub getReply { } if ($reply =~ /\$factoids/) { - my $count = &countKeys("factoids"); + my $factoids = &countKeys("factoids"); $reply =~ s/\$factoids/$factoids/; } @@ -251,64 +355,7 @@ sub getReply { $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;