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] , $chan);
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" );
197 my ($str,$chan) = @_;
202 # to make it eleeter, split each arg and use "blah OR blah or BLAH"
203 # which will make it less than linear => quicker!
204 # TODO: cache this, update cache when altered. !!! !!! !!!
205 # my $t = &timeget();
206 my ($first) = split( /\s+/, $str );
208 # ignore split to commands [dumb commands vs. factoids] (editing commands?)
209 return undef if $str =~ /\s+\=\~\s+s[\#\/\:]/;
211 (&searchTable( 'factoids', 'factoid_key', 'factoid_key', "^$chan cmd: $first " ),
212 &searchTable( 'factoids', 'factoid_key', 'factoid_key', "^_default cmd: $first " ),
213 &searchTable( 'factoids', 'factoid_key', 'factoid_key', "^cmd: $first " ));
215 &DEBUG("chan is $chan, first is $first; searching for '^$chan cmd: $first' ");
217 # my $delta_time = &timedelta($t);
218 # &DEBUG("factArgs: delta_time = $delta_time s");
219 &DEBUG("factArgs: list[.".scalar(@list)."] => ".join(',',map {qq('$_')} @list);
221 # from a design perspective, it's better to have the regex in
222 # the factoid key to reduce repetitive processing.
224 # it does not matter if it's not alphabetically sorted.
225 foreach ( (sort { length($b) <=> length($a) } grep {$_ =~ /^\Q$chan \E/} @list),
226 (sort { length($b) <=> length($a) } grep {$_ =~ /^\Q_default \E/} @list)
227 (sort { length($b) <=> length($a) } grep {$_ !~ /^(\Q$chan\E|default) /} @list)
229 next if (/#DEL#/); # deleted.
234 # &DEBUG("factarg: '$str' =~ /^$_\$/");
237 # eval (evil!) code. cleaned up courtesy of lear.
239 eval { @vals = ( $str =~ /^$arg$/i ); };
242 &WARN("factargs: regex failed! '$str' =~ /^$_\$/");
248 if ( defined $result ) {
249 &WARN("factargs: '$_' matches aswell.");
253 # &DEBUG("vals => @vals");
255 &status("Question: factoid Arguments for '$str'");
257 # TODO: use getReply() - need to modify it :(
260 my $r = &getFactoid($q);
262 &DEBUG("question: !result... should this happen?");
266 # update stats. old mysql/sqlite don't do +1
268 &sqlSelect( 'factoids', 'requested_count', { factoid_key => $q } );
272 { 'factoid_key' => $q },
274 requested_by => $nuh,
275 requested_time => time(),
276 requested_count => $count
280 # end of update stats.
284 $result =~ s/^\((.*?)\): //;
287 # start nasty hack to get partial &getReply() functionality.
288 $result = &SARit($result);
290 foreach ( split( ',', $vars ) ) {
293 # &DEBUG("val => $val");
295 if ( !defined $val ) {
297 "factArgs: vals[$i] == undef; not SARing '$_' for '$str'");
305 # &DEBUG("Q: result => $result (1before)");
306 $result = &substVars( $result, 1 );
308 # &DEBUG("Q: result => $result (1after)");
310 last if ( $old eq $result );
316 $vals[$i] =~ s/^me$/$who/gi;
319 &status("factArgs: SARing '$_' to '$vals[$i]'.");
320 $result =~ s/\Q$_\E/$vals[$i]/g;
326 # rest of nasty hack to get partial &getReply() functionality.
327 $result =~ s/^\s*<action>\s*(.*)/\cAACTION $1\cA/i;
328 $result =~ s/^\s*<reply>\s*//i;
330 # well... lets go through all of them. not advisable if we have like
331 # 1000 commands, heh.
333 $cmdstats{'Factoid Commands'}++;
341 # vim:ts=4:sw=4:expandtab:tw=80