src/Factoids/Question.pl

   1 ###
   2 ### Question.pl: Kevin Lenzo  (c) 1997
   3 ###
   4
   5 ##  doQuestion --
   6 ##      if ($query == query) {
   7 ##              return $value;
   8 ##      } else {
   9 ##              return NULL;
  10 ##      }
  11 ##
  12 ##
  13
  14 if (&IsParam("useStrict")) { use strict; }
  15
  16 use vars qw($query $reply $finalQMark $nuh $result $talkok $who $nuh);
  17 use vars qw(%bots %forked);
  18
  19 sub doQuestion {
  20     # my doesn't allow variables to be inherinted, local does.
  21     # following is used in math()...
  22     local($query)       = @_;
  23     local($reply)       = "";
  24     local $finalQMark   = $query =~ s/\?+\s*$//;
  25     $finalQMark         += $query =~ s/\?\s*$//;
  26     $query              =~ s/^\s+|\s+$//g;
  27
  28     if (!defined $query or $query =~ /^\s*$/) {
  29         return '';
  30     }
  31
  32     my $questionWord    = "";
  33
  34     if (!$addressed) {
  35         return '' unless ($finalQMark);
  36         return '' if (&IsParam("minVolunteerLength") == 0);
  37         return '' if (length $query < $param{'minVolunteerLength'});
  38     } else {
  39         ### TODO: this should be caught in Process.pl?
  40         return '' unless ($talkok);
  41     }
  42
  43     # dangerous; common preambles should be stripped before here
  44     if ($query =~ /^forget /i or $query =~ /^no, /) {
  45         return if (exists $bots{$nuh});
  46     }
  47
  48     # convert to canonical reference form
  49     my $x;
  50     my @query;
  51
  52     push(@query, $query);       # 1: push original.
  53
  54     # valid factoid.
  55     if ($query =~ s/[!.]$//) {
  56         push(@query,$query);
  57     }
  58
  59     $x = &normquery($query);
  60     push(@query, $x) if ($x ne $query);
  61     $query = $x;
  62
  63     $x = &switchPerson($query);
  64     push(@query, $x) if ($x ne $query);
  65     $query = $x;
  66
  67     $query =~ s/\s+at\s*(\?*)$/$1/;     # where is x at?
  68     $query =~ s/^explain\s*(\?*)/$1/i;  # explain x
  69     $query = " $query ";                # side whitespaces.
  70
  71     my $qregex = join '|', keys %{ $lang{'qWord'} };
  72
  73     # what's whats => what is; who'?s => who is, etc
  74     $query =~ s/ ($qregex)\'?s / $1 is /i;
  75     if ($query =~ s/\s+($qregex)\s+//i) { # check for question word
  76         $questionWord = lc($1);
  77     }
  78
  79     if ($questionWord eq "" and $finalQMark and $addressed) {
  80         $questionWord = "where";
  81     }
  82
  83     if (&IsChanConf("factoidArguments")) {
  84         # to make it eleeter, split each arg and use "blah OR blah or BLAH"
  85         # which will make it less than linear => quicker!
  86         # todo: cache this, update cache when altered.
  87         my @list = &searchTable("factoids", "factoid_key", "factoid_key", "CMD: ");
  88
  89         # from a design perspective, it's better to have the regex in
  90         # the factoid key to reduce repetitive processing.
  91
  92         foreach (@list) {
  93             s/^CMD: //;
  94 #           &DEBUG("factarg: ''$query[0]' =~ /^$_\$/'");
  95             my @vals;
  96             my $arg = $_;
  97
  98             eval {
  99                 next unless ($query[0] =~ /^$arg$/i);
 100
 101                 for ($i=1; $i<=5; $i++) {
 102                     $val = $$i;
 103                     last unless (defined $val);
 104
 105                     push(@vals, $val);
 106                 }
 107             };
 108
 109             if ($@) {   # it failed!!!
 110                 &WARN("factargs: regex failed! '$query[0]' =~ /^$_\$/");
 111                 next;
 112             }
 113
 114             &status("Question: factoid Arguments for '$query[0]'");
 115             # todo: use getReply() - need to modify it :(
 116             my $i       = 0;
 117             my $result  = &getFactoid("CMD: $_");
 118             $result     =~ s/^\((.*?)\): //;
 119
 120             foreach ( split(',', $1) ) {
 121                 my $val = $vals[$i];
 122                 if (!defined $val) {
 123                     &status("factArgs: vals[$i] == undef; not SARing '$_' for '$query[0]'");
 124                     next;
 125                 }
 126
 127                 &status("factArgs: SARing '$_' to '$vals[$i]'.");
 128                 $result =~ s/\Q$_\E/$vals[$i]/;
 129                 $i++;
 130             }
 131
 132             # nasty hack to get partial &getReply() functionality.
 133             $result =~ s/^\s*<action>\s*(.*)/\cAACTION $1\cA/i;
 134             $result =~ s/^\s*<reply>\s*//i;
 135
 136             return $result;
 137         }
 138     }
 139
 140     my @link;
 141     for (my$i=0; $i<scalar @query; $i++) {
 142         $query  = $query[$i];
 143         $result = &getReply($query);
 144         next if (!defined $result or $result eq "");
 145
 146         # 'see also' factoid redirection support.
 147
 148         while ($result =~ /^see( also)? (.*?)\.?$/) {
 149             my $link    = $2;
 150
 151             if (grep /^$link$/i, @link) {
 152                 &status("recursive link found; bailing out.");
 153                 last;
 154             }
 155
 156             if (scalar @link >= 5) {
 157                 &status("recursive link limit reached.");
 158                 last;
 159             }
 160
 161             push(@link, $link);
 162             my $newr = &getReply($link);
 163             last if (!defined $newr or $newr eq "");
 164             $result  = $newr;
 165         }
 166
 167         if (@link) {
 168             &status("'$query' linked to: ".join(" => ", @link) );
 169         }
 170
 171         if ($i != 0) {
 172             &VERB("Question.pl: '$query[0]' did not exist; '$query[$i]' ($i) did",2);
 173         }
 174
 175         return $result;
 176     }
 177
 178     ### TODO: Use &Forker(); move function to Freshmeat.pl.
 179     if (&IsChanConf("freshmeatForFactoid")) {
 180         &loadMyModule($myModules{'freshmeat'});
 181         $result = &Freshmeat::showPackage($query);
 182         return $result if (defined $result);
 183     }
 184
 185     ### TODO: Use &Forker(); move function to Debian.pl
 186     if (&IsChanConf("debianForFactoid")) {
 187         &loadMyModule($myModules{'debian'});
 188         $result = &Debian::DebianFind($query);  # ???
 189         ### TODO: debian module should tell, through shm, that it went
 190         ###       ok or not.
 191 ###     return $result if (defined $result);
 192     }
 193
 194     if ($questionWord ne "" or $finalQMark) {
 195         # if it has not been explicitly marked as a question
 196         if ($addressed and $reply eq "") {
 197             &status("notfound: <$who> ".join(' :: ', @query))
 198                                                 if ($finalQMark);
 199
 200             return '' unless (&IsParam("friendlyBots"));
 201
 202             foreach (split /\s+/, $param{'friendlyBots'}) {
 203                 &msg($_, ":INFOBOT:QUERY <$who> $query");
 204             }
 205         }
 206     }
 207
 208     return $reply;
 209 }
 210
 211 1;