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     if ($query =~ s/^literal\s+//i) {
  49         &status("literal ask of '$query'.");
  50         $literal = 1;
  51     }
  52
  53     # convert to canonical reference form
  54     my $x;
  55     my @query;
  56
  57     push(@query, $query);       # 1: push original.
  58
  59     # valid factoid.
  60     if ($query =~ s/[!.]$//) {
  61         push(@query,$query);
  62     }
  63
  64     $x = &normquery($query);
  65     push(@query, $x) if ($x ne $query);
  66     $query = $x;
  67
  68     $x = &switchPerson($query);
  69     push(@query, $x) if ($x ne $query);
  70     $query = $x;
  71
  72     $query =~ s/\s+at\s*(\?*)$/$1/;     # where is x at?
  73     $query =~ s/^explain\s*(\?*)/$1/i;  # explain x
  74     $query = " $query ";                # side whitespaces.
  75
  76     my $qregex = join '|', keys %{ $lang{'qWord'} };
  77
  78     # what's whats => what is; who'?s => who is, etc
  79     $query =~ s/ ($qregex)\'?s / $1 is /i;
  80     if ($query =~ s/\s+($qregex)\s+//i) { # check for question word
  81         $questionWord = lc($1);
  82     }
  83
  84     if ($questionWord eq "" and $finalQMark and $addressed) {
  85         $questionWord = "where";
  86     }
  87
  88     if (&IsChanConf("factoidArguments")) {
  89         $result = &factoidArgs($query[0]);
  90         return $result if (defined $result);
  91     }
  92
  93     my @link;
  94     for (my$i=0; $i<scalar @query; $i++) {
  95         $query  = $query[$i];
  96         $result = &getReply($query);
  97         next if (!defined $result or $result eq "");
  98
  99         # 'see also' factoid redirection support.
 100
 101         while ($result =~ /^see( also)? (.*?)\.?$/) {
 102             my $link    = $2;
 103
 104             if (grep /^$link$/i, @link) {
 105                 &status("recursive link found; bailing out.");
 106                 last;
 107             }
 108
 109             if (scalar @link >= 5) {
 110                 &status("recursive link limit reached.");
 111                 last;
 112             }
 113
 114             push(@link, $link);
 115             my $newr = &getReply($link);
 116             last if (!defined $newr or $newr eq "");
 117             $result  = $newr;
 118         }
 119
 120         if (@link) {
 121             &status("'$query' linked to: ".join(" => ", @link) );
 122         }
 123
 124         if ($i != 0) {
 125             &VERB("Question.pl: '$query[0]' did not exist; '$query[$i]' ($i) did",2);
 126         }
 127
 128         return $result;
 129     }
 130
 131     ### TODO: Use &Forker(); move function to Freshmeat.pl.
 132     if (&IsChanConf("freshmeatForFactoid")) {
 133         &loadMyModule($myModules{'freshmeat'});
 134         $result = &Freshmeat::showPackage($query);
 135         return $result if (defined $result);
 136     }
 137
 138     ### TODO: Use &Forker(); move function to Debian.pl
 139     if (&IsChanConf("debianForFactoid")) {
 140         &loadMyModule($myModules{'debian'});
 141         $result = &Debian::DebianFind($query);  # ???
 142         ### TODO: debian module should tell, through shm, that it went
 143         ###       ok or not.
 144 ###     return $result if (defined $result);
 145     }
 146
 147     if ($questionWord ne "" or $finalQMark) {
 148         # if it has not been explicitly marked as a question
 149         if ($addressed and $reply eq "") {
 150             &status("notfound: <$who> ".join(' :: ', @query))
 151                                                 if ($finalQMark);
 152
 153             return '' unless (&IsParam("friendlyBots"));
 154
 155             foreach (split /\s+/, $param{'friendlyBots'}) {
 156                 &msg($_, ":INFOBOT:QUERY <$who> $query");
 157             }
 158         }
 159     }
 160
 161     return $reply;
 162 }
 163
 164 sub factoidArgs {
 165     my($str)    = @_;
 166     my $result;
 167
 168     # to make it eleeter, split each arg and use "blah OR blah or BLAH"
 169     # which will make it less than linear => quicker!
 170     # todo: cache this, update cache when altered.
 171     my @list = &searchTable("factoids", "factoid_key", "factoid_key", "CMD: ");
 172
 173     # from a design perspective, it's better to have the regex in
 174     # the factoid key to reduce repetitive processing.
 175
 176     foreach (@list) {
 177         next if (/#DEL#/);      # deleted.
 178
 179         s/^CMD: //;
 180 #       &DEBUG("factarg: ''$str' =~ /^$_\$/'");
 181         my @vals;
 182         my $arg = $_;
 183
 184         # todo: make eval work with $$i's :(
 185         eval {
 186             if ($str =~ /^$arg$/i) {
 187                 for ($i=1; $i<=5; $i++) {
 188                     $val = $$i;
 189                     last unless (defined $val);
 190
 191                     push(@vals, $val);
 192                 }
 193             }
 194         };
 195
 196         if ($@) {   # it failed!!!
 197             &WARN("factargs: regex failed! '$str' =~ /^$_\$/");
 198             next;
 199         }
 200
 201         next unless (@vals);
 202
 203 #       &DEBUG("vals => @vals");
 204
 205         &status("Question: factoid Arguments for '$str'");
 206         # todo: use getReply() - need to modify it :(
 207         my $i   = 0;
 208         $result = &getFactoid("CMD: $_");
 209         $result =~ s/^\((.*?)\): //;
 210
 211         foreach ( split(',', $1) ) {
 212             my $val = $vals[$i];
 213 #           &DEBUG("val => $val");
 214
 215             if (!defined $val) {
 216                 &status("factArgs: vals[$i] == undef; not SARing '$_' for '$str'");
 217                 next;
 218             }
 219
 220             my $done = 0;
 221             my $old = $result;
 222             while (1) {
 223 #               &DEBUG("Q: result => $result (1)");
 224                 $result = &substVars($result);
 225 #               &DEBUG("Q: result => $result (1)");
 226
 227                 last if ($old eq $result);
 228                 $old = $result;
 229                 $done++;
 230             }
 231
 232             # hack.
 233             $vals[$i] =~ s/^me$/$who/gi;
 234
 235             if (!$done) {
 236                 &status("factArgs: SARing '$_' to '$vals[$i]'.");
 237                 $result =~ s/\Q$_\E/$vals[$i]/;
 238             }
 239             $i++;
 240         }
 241
 242         # nasty hack to get partial &getReply() functionality.
 243         $result =~ s/^\s*<action>\s*(.*)/\cAACTION $1\cA/i;
 244         $result =~ s/^\s*<reply>\s*//i;
 245         $result = &SARit($result);
 246 #       $result = &substVars($result);
 247
 248         return $result;
 249     }
 250
 251     return;
 252 }
 253
 254 1;