X-Git-Url: https://git.donarmstrong.com/?p=infobot.git;a=blobdiff_plain;f=src%2FFactoids%2FQuestion.pl;h=3fdccee7aa06fe6ffaae23cce76db205828c0f26;hp=3e689ab5bc86f40ee347e83199b1f1671ff0e2ae;hb=ab817c7c909abba1654f3b8691961ec8694e8169;hpb=64b1ab9e23f7895f1ab62a8168d77955a11451fc diff --git a/src/Factoids/Question.pl b/src/Factoids/Question.pl index 3e689ab..3fdccee 100644 --- a/src/Factoids/Question.pl +++ b/src/Factoids/Question.pl @@ -11,144 +11,321 @@ ## ## -if (&IsParam("useStrict")) { use strict; } +# use strict; # TODO use vars qw($query $reply $finalQMark $nuh $result $talkok $who $nuh); use vars qw(%bots %forked); sub doQuestion { + # my doesn't allow variables to be inherinted, local does. # following is used in math()... - local($query) = @_; - local($reply) = ""; - local $finalQMark = $query =~ s/\?+\s*$//; - $finalQMark += $query =~ s/\?\s*$//; - $query =~ s/^\s+|\s+$//g; - - if (!defined $query or $query =~ /^\s*$/) { - return ''; - } + local ($query) = @_; + local ($reply) = ''; + local $finalQMark = $query =~ s/\?+\s*$//; + $query =~ s/^\s+|\s+$//g; - my $questionWord = ""; + if ( !defined $query or $query =~ /^\s*$/ ) { + return ''; + } - if (!$addressed) { - return '' unless ($finalQMark); - return '' if (&IsParam("minVolunteerLength") == 0); - return '' if (length $query < $param{'minVolunteerLength'}); - } else { - ### TODO: this should be caught in Process.pl? - return '' unless ($talkok); + my $questionWord = ''; + + if ( !$addressed ) { + return '' unless ($finalQMark); + return '' + if ( + length $query < + &::getChanConfDefault( 'minVolunteerLength', 2, $chan ) or + $param{'addressing'} =~ m/require/i ); + return '' + if ( + length $query > + &::getChanConfDefault( 'maxVolunteerLength', 512, $chan ) or + $param{'addressing'} =~ m/require/i ); + } + else { + ### TODO: this should be caught in Process.pl? + return '' unless ($talkok); + + # there is no flag to disable/enable asking factoids... + # so it was added... thanks zyxep! :) + if ( &IsFlag('a') ne 'a' && &IsFlag('o') ne 'o' ) { + &status("$who tried to ask us when not allowed."); + return; + } } # dangerous; common preambles should be stripped before here - if ($query =~ /^forget /i or $query =~ /^no, /) { - return if (exists $bots{$nuh}); + if ( $query =~ /^forget /i or $query =~ /^no, / ) { + return if ( exists $bots{$nuh} ); + } + + if ( $query =~ s/^literal\s+//i ) { + &status("literal ask of '$query'."); + $literal = 1; } # convert to canonical reference form my $x; my @query; - push(@query, $query); # 1: push original. + push( @query, $query ); # 1: push original. # valid factoid. - if ($query =~ s/[!.]$//) { - push(@query,$query); + if ( $query =~ s/[!.]$// ) { + push( @query, $query ); } $x = &normquery($query); - push(@query, $x) if ($x ne $query); + push( @query, $x ) if ( $x ne $query ); $query = $x; $x = &switchPerson($query); - push(@query, $x) if ($x ne $query); + push( @query, $x ) if ( $x ne $query ); $query = $x; - $query =~ s/\s+at\s*(\?*)$/$1/; # where is x at? - $query =~ s/^explain\s*(\?*)/$1/i; # explain x - $query = " $query "; # side whitespaces. + $query =~ s/\s+at\s*(\?*)$/$1/; # where is x at? + $query =~ s/^explain\s*(\?*)/$1/i; # explain x + $query = " $query "; # side whitespaces. my $qregex = join '|', keys %{ $lang{'qWord'} }; - # what's whats => what is; who'?s => who is, etc - $query =~ s/ ($qregex)\'?s / $1 is /i; - if ($query =~ s/\s+($qregex)\s+//i) { # check for question word - $questionWord = lc($1); + # purge prefix question string. + if ( $query =~ s/^ ($qregex)//i ) { + $questionWord = lc($1); } - if ($questionWord eq "" and $finalQMark and $addressed) { - $questionWord = "where"; + if ( $questionWord eq '' and $finalQMark and $addressed ) { + $questionWord = 'where'; + } + $query =~ s/^\s+|\s+$//g; # bleh. hacked. + push( @query, $query ) if ( $query ne $x ); + + if ( &IsChanConf('factoidArguments') > 0 ) { + $result = &factoidArgs( $query[0] ); + + return $result if ( defined $result ); } my @link; - for (my$i=0; $i= 5 ) { + &status("recursive link limit (5) reached."); + last; + } + + push( @link, $link ); + my $newr = &getReply($link); + + # no such factoid. try commands + if ( !defined $newr || $newr =~ /^0?$/ ) { + + # support command redirection. + # recursive cmdHooks aswell :) + my $done = 0; + $done++ if &parseCmdHook($link); + $message = $link; + $done++ unless ( &Modules() ); + + return; + } + last if ( !defined $newr or $newr eq '' ); + $result = $newr; + } + + if (@link) { + &status( "'$query' linked to: " . join( " => ", @link ) ); + } + + if ( $i != 0 ) { + &VERB( + "Question.pl: '$query[0]' did not exist; '$query[$i]' ($i) did", + 2 + ); + } + + return $result; + } + + ### TODO: Use &Forker(); move function to Debian.pl + if ( &IsChanConf('debianForFactoid') > 0 ) { + &loadMyModule('Debian'); + $result = &Debian::DebianFind($query); # ??? + ### TODO: debian module should tell, through shm, that it went + ### ok or not. +### return $result if (defined $result); + } - # 'see also' factoid redirection support. + if ( $questionWord ne '' or $finalQMark ) { - while ($result =~ /^see( also)? (.*?)\.?$/) { - my $link = $2; + # if it has not been explicitly marked as a question + if ( $addressed and $reply eq '' ) { + &status( "notfound: <$who> " . join( ' :: ', @query ) ) + if ($finalQMark); - if (grep /^$link$/i, @link) { - &status("recursive link found; bailing out."); - last; - } + return '' unless ( &IsParam('friendlyBots') ); - if (scalar @link >= 5) { - &status("recursive link limit reached."); - last; - } + foreach ( split /\s+/, $param{'friendlyBots'} ) { + &msg( $_, ":INFOBOT:QUERY <$who> $query" ); + } + } + } - push(@link, $link); - my $newr = &getReply($link); - last if (!defined $newr or $newr eq ""); - $result = $newr; - } + return $reply; +} - if (@link) { - &status("'$query' linked to: ".join(" => ", @link) ); - } +sub factoidArgs { + my ($str) = @_; + my $result; - if ($i != 0) { - &DEBUG("Question: '$query[0]' did not exist; '$query[$i]' ($i) did"); - } + # to make it eleeter, split each arg and use "blah OR blah or BLAH" + # which will make it less than linear => quicker! + # TODO: cache this, update cache when altered. !!! !!! !!! + # my $t = &timeget(); + my ($first) = split( /\s+/, $str ); - return $result; - } + # ignore split to commands [dumb commands vs. factoids] (editing commands?) + return undef if $str =~ /\s+\=\~\s+s[\#\/\:]/; + my @list = + &searchTable( 'factoids', 'factoid_key', 'factoid_key', "^cmd: $first " ); - ### TODO: Use &Forker(); move function to Freshmeat.pl. - if (&IsChanConf("freshmeatForFactoid")) { - &loadMyModule($myModules{'freshmeat'}); - $result = &Freshmeat::showPackage($query); - return $result if (defined $result); - } + # my $delta_time = &timedelta($t); + # &DEBUG("factArgs: delta_time = $delta_time s"); + # &DEBUG("factArgs: list => ".scalar(@list) ); - ### TODO: Use &Forker(); move function to Debian.pl - if (&IsChanConf("debianForFactoid")) { - &loadMyModule($myModules{'debian'}); - $result = &Debian::DebianFind($query); # ??? - ### TODO: debian module should tell, through shm, that it went - ### ok or not. -### return $result if (defined $result); - } + # from a design perspective, it's better to have the regex in + # the factoid key to reduce repetitive processing. + + # it does not matter if it's not alphabetically sorted. + foreach ( sort { length($b) <=> length($a) } @list ) { + next if (/#DEL#/); # deleted. + + s/^cmd: //i; - if ($questionWord ne "" or $finalQMark) { - # if it has not been explicitly marked as a question - if ($addressed and $reply eq "") { - &status("notfound: <$who> ".join(' :: ', @query)) - if ($finalQMark); + # &DEBUG("factarg: '$str' =~ /^$_\$/"); + my $arg = $_; - return '' unless (&IsParam("friendlyBots")); + # eval (evil!) code. cleaned up courtesy of lear. + my @vals; + eval { @vals = ( $str =~ /^$arg$/i ); }; - foreach (split /\s+/, $param{'friendlyBots'}) { - &msg($_, ":INFOBOT:QUERY <$who> $query"); - } - } + if ($@) { + &WARN("factargs: regex failed! '$str' =~ /^$_\$/"); + next; + } + + next unless (@vals); + + if ( defined $result ) { + &WARN("factargs: '$_' matches aswell."); + next; + } + + # &DEBUG("vals => @vals"); + + &status("Question: factoid Arguments for '$str'"); + + # TODO: use getReply() - need to modify it :( + my $i = 0; + my $q = "cmd: $_"; + my $r = &getFactoid($q); + if ( !defined $r ) { + &DEBUG("question: !result... should this happen?"); + return; + } + + # update stats. old mysql/sqlite don't do +1 + my ($count) = + &sqlSelect( 'factoids', 'requested_count', { factoid_key => $q } ); + $count++; + &sqlSet( + 'factoids', + { 'factoid_key' => $q }, + { + requested_by => $nuh, + requested_time => time(), + requested_count => $count + } + ); + + # end of update stats. + + $result = $r; + + $result =~ s/^\((.*?)\): //; + my $vars = $1; + + # start nasty hack to get partial &getReply() functionality. + $result = &SARit($result); + + foreach ( split( ',', $vars ) ) { + my $val = $vals[$i]; + + # &DEBUG("val => $val"); + + if ( !defined $val ) { + &status( + "factArgs: vals[$i] == undef; not SARing '$_' for '$str'"); + next; + } + + my $done = 0; + my $old = $result; + while (1) { + + # &DEBUG("Q: result => $result (1before)"); + $result = &substVars( $result, 1 ); + + # &DEBUG("Q: result => $result (1after)"); + + last if ( $old eq $result ); + $old = $result; + $done++; + } + + # hack. + $vals[$i] =~ s/^me$/$who/gi; + + # if (!$done) { + &status("factArgs: SARing '$_' to '$vals[$i]'."); + $result =~ s/\Q$_\E/$vals[$i]/g; + + # } + $i++; + } + + # rest of nasty hack to get partial &getReply() functionality. + $result =~ s/^\s*\s*(.*)/\cAACTION $1\cA/i; + $result =~ s/^\s*\s*//i; + + # well... lets go through all of them. not advisable if we have like + # 1000 commands, heh. + # return $result; + $cmdstats{'Factoid Commands'}++; } - return $reply; + return $result; } 1; + +# vim:ts=4:sw=4:expandtab:tw=80