X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=src%2FFactoids%2FQuestion.pl;h=39b5df2644fc7ca36e532233b2f697ceb4ce781b;hb=cb81fea9939f349b36e3b5a0cdc0343a6b781da1;hp=a5ced7be4eccce166a3a756538857a24ffb054c2;hpb=02dd5778cf86851ed8158551400149133843516a;p=infobot.git

diff --git a/src/Factoids/Question.pl b/src/Factoids/Question.pl
index a5ced7b..39b5df2 100644
--- a/src/Factoids/Question.pl
+++ b/src/Factoids/Question.pl
@@ -11,7 +11,7 @@
 ##
 ##
 
-if (&IsParam("useStrict")) { use strict; }
+# use strict;	# TODO
 
 use vars qw($query $reply $finalQMark $nuh $result $talkok $who $nuh);
 use vars qw(%bots %forked);
@@ -20,7 +20,7 @@ sub doQuestion {
     # my doesn't allow variables to be inherinted, local does.
     # following is used in math()...
     local($query)	= @_;
-    local($reply)	= "";
+    local($reply)	= '';
     local $finalQMark	= $query =~ s/\?+\s*$//;
     $finalQMark		+= $query =~ s/\?\s*$//;
     $query		=~ s/^\s+|\s+$//g;
@@ -29,15 +29,22 @@ sub doQuestion {
 	return '';
     }
 
-    my $questionWord	= "";
+    my $questionWord	= '';
 
     if (!$addressed) {
 	return '' unless ($finalQMark);
-	return '' if (&IsParam("minVolunteerLength") == 0);
-	return '' if (length $query < $param{'minVolunteerLength'});
+	return '' unless &IsChanConf('minVolunteerLength') > 0;
+	return '' if (length $query < &::getChanConf('minVolunteerLength'));
     } 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
@@ -45,6 +52,11 @@ sub doQuestion {
 	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;
@@ -53,7 +65,7 @@ sub doQuestion {
 
     # valid factoid.
     if ($query =~ s/[!.]$//) {
-	push(@query,$query);
+	push(@query, $query);
     }
 
     $x = &normquery($query);
@@ -70,18 +82,20 @@ sub doQuestion {
 
     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
+    # 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")) {
+    if (&IsChanConf('factoidArguments') > 0) {
 	$result = &factoidArgs($query[0]);
+
 	return $result if (defined $result);
     }
 
@@ -89,26 +103,42 @@ sub doQuestion {
     for (my$i=0; $i<scalar @query; $i++) {
 	$query	= $query[$i];
 	$result = &getReply($query);
-	next if (!defined $result or $result eq "");
+	next if (!defined $result or $result eq '');
 
 	# 'see also' factoid redirection support.
 
 	while ($result =~ /^see( also)? (.*?)\.?$/) {
 	    my $link	= $2;
 
-	    if (grep /^$link$/i, @link) {
+	    # #debian@OPN was having problems with libstdc++ factoid
+	    # redirection :) 20021116. -xk.
+	    # hrm... allow recursive loops... next if statement handles
+	    # that.
+	    if (grep /^\Q$link\E$/i, @link) {
 		&status("recursive link found; bailing out.");
 		last;
 	    }
 
 	    if (scalar @link >= 5) {
-		&status("recursive link limit reached.");
+		&status("recursive link limit (5) reached.");
 		last;
 	    }
 
 	    push(@link, $link);
 	    my $newr = &getReply($link);
-	    last if (!defined $newr or $newr eq "");
+
+	    # 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;
 	}
 
@@ -123,29 +153,22 @@ sub doQuestion {
 	return $result;
     }
 
-    ### TODO: Use &Forker(); move function to Freshmeat.pl.
-    if (&IsChanConf("freshmeatForFactoid")) {
-	&loadMyModule($myModules{'freshmeat'});
-	$result = &Freshmeat::showPackage($query);
-	return $result if (defined $result);
-    }
-
     ### TODO: Use &Forker(); move function to Debian.pl
-    if (&IsChanConf("debianForFactoid")) {
-	&loadMyModule($myModules{'debian'});
+    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);
     }
 
-    if ($questionWord ne "" or $finalQMark) {
+    if ($questionWord ne '' or $finalQMark) {
 	# if it has not been explicitly marked as a question
-	if ($addressed and $reply eq "") {
+	if ($addressed and $reply eq '') {
 	    &status("notfound: <$who> ".join(' :: ', @query))
 						if ($finalQMark);
 
-	    return '' unless (&IsParam("friendlyBots"));
+	    return '' unless (&IsParam('friendlyBots'));
 
 	    foreach (split /\s+/, $param{'friendlyBots'}) {
 		&msg($_, ":INFOBOT:QUERY <$who> $query");
@@ -162,71 +185,121 @@ sub factoidArgs {
 
     # 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 @list = &searchTable("factoids", "factoid_key", "factoid_key", "CMD: ");
+    # TODO: cache this, update cache when altered. !!! !!! !!!
+#    my $t = &timeget();
+    my ($first) = split(/\s+/, $str);
+
+    # 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 ");
+#    my $delta_time = &timedelta($t);
+#    &DEBUG("factArgs: delta_time = $delta_time s");
+#    &DEBUG("factArgs: list => ".scalar(@list) );
 
     # from a design perspective, it's better to have the regex in
     # the factoid key to reduce repetitive processing.
 
-    foreach (@list) {
+    # it does not matter if it's not alphabetically sorted.
+    foreach (sort { length($b) <=> length($a) } @list) {
 	next if (/#DEL#/);	# deleted.
 
-	s/^CMD: //;
-#	&DEBUG("factarg: ''$str' =~ /^$_\$/'");
-	my @vals;
+	s/^cmd: //i;
+#	&DEBUG("factarg: '$str' =~ /^$_\$/");
 	my $arg = $_;
 
-	# todo: make eval work with $$i's :(
+	# eval (evil!) code. cleaned up courtesy of lear.
+	my @vals;
 	eval {
-	    if ($str =~ /^$arg$/i) {
-		for ($i=1; $i<=5; $i++) {
-		    $val = $$i;
-		    last unless (defined $val);
-
-		    push(@vals, $val);
-		}
-	    }
+	    @vals = ($str =~ /^$arg$/i);
 	};
 
-	if ($@) {   # it failed!!!
+	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 :(
+	# TODO: use getReply() - need to modify it :(
 	my $i	= 0;
-	$result	= &getFactoid("CMD: $_");
+	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(',', $1) ) {
+	foreach ( split(',', $vars) ) {
 	    my $val = $vals[$i];
+#	    &DEBUG("val => $val");
+
 	    if (!defined $val) {
 		&status("factArgs: vals[$i] == undef; not SARing '$_' for '$str'");
 		next;
 	    }
 
-	    if ($result = &substVars($result)) {
-		# hrm...
-	    } else {
-		&status("factArgs: SARing '$_' to '$vals[$i]'.");
-		$result =~ s/\Q$_\E/$vals[$i]/;
-		$i++;
+	    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++;
 	}
 
-	# nasty hack to get partial &getReply() functionality.
+	# rest of nasty hack to get partial &getReply() functionality.
 	$result =~ s/^\s*<action>\s*(.*)/\cAACTION $1\cA/i;
 	$result =~ s/^\s*<reply>\s*//i;
-	$result = &SARit($result);
-#	$result = &substVars($result);
 
-	return $result;
+# well... lets go through all of them. not advisable if we have like
+# 1000 commands, heh.
+#	return $result;
+	$cmdstats{'Factoid Commands'}++;
     }
 
-    return;
+    return $result;
 }
 
 1;
+
+# vim:ts=4:sw=4:expandtab:tw=80