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 $finalQMark += $query =~ s/\?\s*$//;
27 $query =~ s/^\s+|\s+$//g;
29 if ( !defined $query or $query =~ /^\s*$/ ) {
33 my $questionWord = '';
36 return '' unless ($finalQMark);
37 return '' unless &IsChanConf('minVolunteerLength') > 0;
38 return '' if ( length $query < &::getChanConf('minVolunteerLength') );
41 ### TODO: this should be caught in Process.pl?
42 return '' unless ($talkok);
44 # there is no flag to disable/enable asking factoids...
45 # so it was added... thanks zyxep! :)
46 if ( &IsFlag('a') ne 'a' && &IsFlag('o') ne 'o' ) {
47 &status("$who tried to ask us when not allowed.");
52 # dangerous; common preambles should be stripped before here
53 if ( $query =~ /^forget /i or $query =~ /^no, / ) {
54 return if ( exists $bots{$nuh} );
57 if ( $query =~ s/^literal\s+//i ) {
58 &status("literal ask of '$query'.");
62 # convert to canonical reference form
66 push( @query, $query ); # 1: push original.
69 if ( $query =~ s/[!.]$// ) {
70 push( @query, $query );
73 $x = &normquery($query);
74 push( @query, $x ) if ( $x ne $query );
77 $x = &switchPerson($query);
78 push( @query, $x ) if ( $x ne $query );
81 $query =~ s/\s+at\s*(\?*)$/$1/; # where is x at?
82 $query =~ s/^explain\s*(\?*)/$1/i; # explain x
83 $query = " $query "; # side whitespaces.
85 my $qregex = join '|', keys %{ $lang{'qWord'} };
87 # purge prefix question string.
88 if ( $query =~ s/^ ($qregex)//i ) {
89 $questionWord = lc($1);
92 if ( $questionWord eq '' and $finalQMark and $addressed ) {
93 $questionWord = 'where';
95 $query =~ s/^\s+|\s+$//g; # bleh. hacked.
96 push( @query, $query ) if ( $query ne $x );
98 if ( &IsChanConf('factoidArguments') > 0 ) {
99 $result = &factoidArgs( $query[0] );
101 return $result if ( defined $result );
105 for ( my $i = 0 ; $i < scalar @query ; $i++ ) {
107 $result = &getReply($query);
108 next if ( !defined $result or $result eq '' );
110 # 'see also' factoid redirection support.
112 while ( $result =~ /^see( also)? (.*?)\.?$/ ) {
115 # #debian@OPN was having problems with libstdc++ factoid
116 # redirection :) 20021116. -xk.
117 # hrm... allow recursive loops... next if statement handles
119 if ( grep /^\Q$link\E$/i, @link ) {
120 &status("recursive link found; bailing out.");
124 if ( scalar @link >= 5 ) {
125 &status("recursive link limit (5) reached.");
129 push( @link, $link );
130 my $newr = &getReply($link);
132 # no such factoid. try commands
133 if ( !defined $newr || $newr =~ /^0?$/ ) {
135 # support command redirection.
136 # recursive cmdHooks aswell :)
138 $done++ if &parseCmdHook($link);
140 $done++ unless ( &Modules() );
144 last if ( !defined $newr or $newr eq '' );
149 &status( "'$query' linked to: " . join( " => ", @link ) );
154 "Question.pl: '$query[0]' did not exist; '$query[$i]' ($i) did",
162 ### TODO: Use &Forker(); move function to Debian.pl
163 if ( &IsChanConf('debianForFactoid') > 0 ) {
164 &loadMyModule('Debian');
165 $result = &Debian::DebianFind($query); # ???
166 ### TODO: debian module should tell, through shm, that it went
168 ### return $result if (defined $result);
171 if ( $questionWord ne '' or $finalQMark ) {
173 # if it has not been explicitly marked as a question
174 if ( $addressed and $reply eq '' ) {
175 &status( "notfound: <$who> " . join( ' :: ', @query ) )
178 return '' unless ( &IsParam('friendlyBots') );
180 foreach ( split /\s+/, $param{'friendlyBots'} ) {
181 &msg( $_, ":INFOBOT:QUERY <$who> $query" );
193 # to make it eleeter, split each arg and use "blah OR blah or BLAH"
194 # which will make it less than linear => quicker!
195 # TODO: cache this, update cache when altered. !!! !!! !!!
196 # my $t = &timeget();
197 my ($first) = split( /\s+/, $str );
199 # ignore split to commands [dumb commands vs. factoids] (editing commands?)
200 return undef if $str =~ /\s+\=\~\s+s[\#\/\:]/;
202 &searchTable( 'factoids', 'factoid_key', 'factoid_key', "^cmd: $first " );
204 # my $delta_time = &timedelta($t);
205 # &DEBUG("factArgs: delta_time = $delta_time s");
206 # &DEBUG("factArgs: list => ".scalar(@list) );
208 # from a design perspective, it's better to have the regex in
209 # the factoid key to reduce repetitive processing.
211 # it does not matter if it's not alphabetically sorted.
212 foreach ( sort { length($b) <=> length($a) } @list ) {
213 next if (/#DEL#/); # deleted.
217 # &DEBUG("factarg: '$str' =~ /^$_\$/");
220 # eval (evil!) code. cleaned up courtesy of lear.
222 eval { @vals = ( $str =~ /^$arg$/i ); };
225 &WARN("factargs: regex failed! '$str' =~ /^$_\$/");
231 if ( defined $result ) {
232 &WARN("factargs: '$_' matches aswell.");
236 # &DEBUG("vals => @vals");
238 &status("Question: factoid Arguments for '$str'");
240 # TODO: use getReply() - need to modify it :(
243 my $r = &getFactoid($q);
245 &DEBUG("question: !result... should this happen?");
249 # update stats. old mysql/sqlite don't do +1
251 &sqlSelect( 'factoids', 'requested_count', { factoid_key => $q } );
255 { 'factoid_key' => $q },
257 requested_by => $nuh,
258 requested_time => time(),
259 requested_count => $count
263 # end of update stats.
267 $result =~ s/^\((.*?)\): //;
270 # start nasty hack to get partial &getReply() functionality.
271 $result = &SARit($result);
273 foreach ( split( ',', $vars ) ) {
276 # &DEBUG("val => $val");
278 if ( !defined $val ) {
280 "factArgs: vals[$i] == undef; not SARing '$_' for '$str'");
288 # &DEBUG("Q: result => $result (1before)");
289 $result = &substVars( $result, 1 );
291 # &DEBUG("Q: result => $result (1after)");
293 last if ( $old eq $result );
299 $vals[$i] =~ s/^me$/$who/gi;
302 &status("factArgs: SARing '$_' to '$vals[$i]'.");
303 $result =~ s/\Q$_\E/$vals[$i]/g;
309 # rest of nasty hack to get partial &getReply() functionality.
310 $result =~ s/^\s*<action>\s*(.*)/\cAACTION $1\cA/i;
311 $result =~ s/^\s*<reply>\s*//i;
313 # well... lets go through all of them. not advisable if we have like
314 # 1000 commands, heh.
316 $cmdstats{'Factoid Commands'}++;
324 # vim:ts=4:sw=4:expandtab:tw=80