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