2 ### Question.pl: Kevin Lenzo (c) 1997
6 ## if ($query == query) {
16 use vars qw($query $reply $finalQMark $nuh $result $talkok $who $nuh);
17 use vars qw(%bots %forked);
21 # my doesn't allow variables to be inherinted, local does.
22 # following is used in math()...
25 local $finalQMark = $query =~ s/\?+\s*$//;
26 $query =~ s/^\s+|\s+$//g;
28 if ( !defined $query or $query =~ /^\s*$/ ) {
32 my $questionWord = '';
35 return '' unless ($finalQMark);
39 &::getChanConfDefault( 'minVolunteerLength', 2, $chan ) or
40 $param{'addressing'} =~ m/require/i );
44 &::getChanConfDefault( 'maxVolunteerLength', 512, $chan ) or
45 $param{'addressing'} =~ m/require/i );
48 ### TODO: this should be caught in Process.pl?
49 return '' unless ($talkok);
51 # there is no flag to disable/enable asking factoids...
52 # so it was added... thanks zyxep! :)
53 if ( &IsFlag('a') ne 'a' && &IsFlag('o') ne 'o' ) {
54 &status("$who tried to ask us when not allowed.");
59 # dangerous; common preambles should be stripped before here
60 if ( $query =~ /^forget /i or $query =~ /^no, / ) {
61 return if ( exists $bots{$nuh} );
64 if ( $query =~ s/^literal\s+//i ) {
65 &status("literal ask of '$query'.");
69 # convert to canonical reference form
73 push( @query, $query ); # 1: push original.
76 if ( $query =~ s/[!.]$// ) {
77 push( @query, $query );
80 $x = &normquery($query);
81 push( @query, $x ) if ( $x ne $query );
84 $x = &switchPerson($query);
85 push( @query, $x ) if ( $x ne $query );
88 $query =~ s/\s+at\s*(\?*)$/$1/; # where is x at?
89 $query =~ s/^explain\s*(\?*)/$1/i; # explain x
90 $query = " $query "; # side whitespaces.
92 my $qregex = join '|', keys %{ $lang{'qWord'} };
94 # purge prefix question string.
95 if ( $query =~ s/^ ($qregex)//i ) {
96 $questionWord = lc($1);
99 if ( $questionWord eq '' and $finalQMark and $addressed ) {
100 $questionWord = 'where';
102 $query =~ s/^\s+|\s+$//g; # bleh. hacked.
103 push( @query, $query ) if ( $query ne $x );
105 if ( &IsChanConf('factoidArguments') > 0 ) {
106 $result = &factoidArgs( $query[0] );
108 return $result if ( defined $result );
112 for ( my $i = 0 ; $i < scalar @query ; $i++ ) {
114 $result = &getReply($query);
115 next if ( !defined $result or $result eq '' );
117 # 'see also' factoid redirection support.
119 while ( $result =~ /^see( also)? (.*?)\.?$/ ) {
122 # #debian@OPN was having problems with libstdc++ factoid
123 # redirection :) 20021116. -xk.
124 # hrm... allow recursive loops... next if statement handles
126 if ( grep /^\Q$link\E$/i, @link ) {
127 &status("recursive link found; bailing out.");
131 if ( scalar @link >= 5 ) {
132 &status("recursive link limit (5) reached.");
136 push( @link, $link );
137 my $newr = &getReply($link);
139 # no such factoid. try commands
140 if ( !defined $newr || $newr =~ /^0?$/ ) {
142 # support command redirection.
143 # recursive cmdHooks aswell :)
145 $done++ if &parseCmdHook($link);
147 $done++ unless ( &Modules() );
151 last if ( !defined $newr or $newr eq '' );
156 &status( "'$query' linked to: " . join( " => ", @link ) );
161 "Question.pl: '$query[0]' did not exist; '$query[$i]' ($i) did",
169 ### TODO: Use &Forker(); move function to Debian.pl
170 if ( &IsChanConf('debianForFactoid') > 0 ) {
171 &loadMyModule('Debian');
172 $result = &Debian::DebianFind($query); # ???
173 ### TODO: debian module should tell, through shm, that it went
175 ### return $result if (defined $result);
178 if ( $questionWord ne '' or $finalQMark ) {
180 # if it has not been explicitly marked as a question
181 if ( $addressed and $reply eq '' ) {
182 &status( "notfound: <$who> " . join( ' :: ', @query ) )
185 return '' unless ( &IsParam('friendlyBots') );
187 foreach ( split /\s+/, $param{'friendlyBots'} ) {
188 &msg( $_, ":INFOBOT:QUERY <$who> $query" );
200 # to make it eleeter, split each arg and use "blah OR blah or BLAH"
201 # which will make it less than linear => quicker!
202 # TODO: cache this, update cache when altered. !!! !!! !!!
203 # my $t = &timeget();
204 my ($first) = split( /\s+/, $str );
206 # ignore split to commands [dumb commands vs. factoids] (editing commands?)
207 return undef if $str =~ /\s+\=\~\s+s[\#\/\:]/;
209 &searchTable( 'factoids', 'factoid_key', 'factoid_key', "^cmd: $first " );
211 # my $delta_time = &timedelta($t);
212 # &DEBUG("factArgs: delta_time = $delta_time s");
213 # &DEBUG("factArgs: list => ".scalar(@list) );
215 # from a design perspective, it's better to have the regex in
216 # the factoid key to reduce repetitive processing.
218 # it does not matter if it's not alphabetically sorted.
219 foreach ( sort { length($b) <=> length($a) } @list ) {
220 next if (/#DEL#/); # deleted.
224 # &DEBUG("factarg: '$str' =~ /^$_\$/");
227 # eval (evil!) code. cleaned up courtesy of lear.
229 eval { @vals = ( $str =~ /^$arg$/i ); };
232 &WARN("factargs: regex failed! '$str' =~ /^$_\$/");
238 if ( defined $result ) {
239 &WARN("factargs: '$_' matches aswell.");
243 # &DEBUG("vals => @vals");
245 &status("Question: factoid Arguments for '$str'");
247 # TODO: use getReply() - need to modify it :(
250 my $r = &getFactoid($q);
252 &DEBUG("question: !result... should this happen?");
256 # update stats. old mysql/sqlite don't do +1
258 &sqlSelect( 'factoids', 'requested_count', { factoid_key => $q } );
262 { 'factoid_key' => $q },
264 requested_by => $nuh,
265 requested_time => time(),
266 requested_count => $count
270 # end of update stats.
274 $result =~ s/^\((.*?)\): //;
277 # start nasty hack to get partial &getReply() functionality.
278 $result = &SARit($result);
280 foreach ( split( ',', $vars ) ) {
283 # &DEBUG("val => $val");
285 if ( !defined $val ) {
287 "factArgs: vals[$i] == undef; not SARing '$_' for '$str'");
295 # &DEBUG("Q: result => $result (1before)");
296 $result = &substVars( $result, 1 );
298 # &DEBUG("Q: result => $result (1after)");
300 last if ( $old eq $result );
306 $vals[$i] =~ s/^me$/$who/gi;
309 &status("factArgs: SARing '$_' to '$vals[$i]'.");
310 $result =~ s/\Q$_\E/$vals[$i]/g;
316 # rest of nasty hack to get partial &getReply() functionality.
317 $result =~ s/^\s*<action>\s*(.*)/\cAACTION $1\cA/i;
318 $result =~ s/^\s*<reply>\s*//i;
320 # well... lets go through all of them. not advisable if we have like
321 # 1000 commands, heh.
323 $cmdstats{'Factoid Commands'}++;
331 # vim:ts=4:sw=4:expandtab:tw=80