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         &FIXME("doQ: query == NULL");
  30         return '';
  31     }
  32
  33     my $origQuery       = $query;
  34     my $questionWord    = "";
  35
  36     if (!$addressed) {
  37         return '' unless ($finalQMark);
  38         return '' if (&IsParam("minVolunteerLength") == 0);
  39         return '' if (length($query) < $param{'minVolunteerLength'});
  40     } else {
  41         ### TODO: this should be caught in Process.pl?
  42         return '' unless ($talkok);
  43     }
  44
  45     # dangerous; common preambles should be stripped before here
  46     if ($query =~ /^forget /i or $query =~ /^no, /) {
  47         return $noreply if (exists $bots{$nuh});
  48     }
  49
  50     # convert to canonical reference form
  51     my $x;
  52     my @query;
  53
  54     push(@query, $query);       # 1: push original.
  55
  56     $x = &normquery($query);
  57     push(@query, $x) if ($x ne $query);
  58     $query = $x;
  59
  60     $x = &switchPerson($query);
  61     push(@query, $x) if ($x ne $query);
  62     $query = $x;
  63
  64     $query =~ s/\s+at\s*(\?*)$/$1/;     # where is x at?
  65     $query =~ s/^explain\s*(\?*)/$1/i;  # explain x
  66     $query = " $query ";                # side whitespaces.
  67
  68     my $qregex = join '|', keys %{$lang{'qWord'}};
  69
  70     # what's whats => what is; who'?s => who is, etc
  71     $query =~ s/ ($qregex)\'?s / $1 is /i;
  72     if ($query =~ s/\s+($qregex)\s+//i) { # check for question word
  73         $questionWord = lc($1);
  74     }
  75
  76     if ($questionWord eq "" and $finalQMark and $addressed) {
  77         $questionWord = "where";
  78     }
  79
  80     # valid factoid.
  81     if ($query =~ s/[\!\.]$//) {
  82         &DEBUG("Question: Pushing query without trailing symbols.");
  83         push(@query,$query);
  84     }
  85
  86     for (my$i=0; $i<scalar(@query); $i++) {
  87         $query = $query[$i];
  88         $result = &getReply($query);
  89         next if ($result eq "");
  90
  91         # 'see also' factoid redirection support.
  92         if ($result =~ /^see( also)? (.*?)\.?$/) {
  93             my $newr = &getReply($2);
  94             $result  = $newr    if ($newr ne "");
  95         }
  96
  97         if ($i != 0) {
  98             &DEBUG("Question: guessed factoid correctly ($i) => '$query'.");
  99         }
 100
 101         return $result;
 102     }
 103
 104     ### TODO: Use &Forker(); move function to Freshmeat.pl.
 105     if (&IsParam("freshmeatForFactoid")) {
 106         &loadMyModule($myModules{'freshmeat'});
 107         $result = &Freshmeat::showPackage($query);
 108         return $result unless ($result eq $noreply);
 109     }
 110
 111     ### TODO: Use &Forker(); move function to Debian.pl
 112     if (&IsParam("debianForFactoid")) {
 113         &loadMyModule($myModules{'debian'});
 114         $result = &Debian::DebianFind($query);  # ???
 115         ### TODO: debian module should tell, through shm, that it went
 116         ###       ok or not.
 117 ###     return $result unless ($result eq $noreply);
 118     }
 119
 120     if ($questionWord ne "" or $finalQMark) {
 121         # if it has not been explicitly marked as a question
 122         if ($addressed and $reply eq "") {
 123             if ($origQuery eq $query) {
 124                 &status("notfound: <$who> $origQuery");
 125             } else {
 126                 &status("notfound: <$who> $origQuery :: $query");
 127             }
 128
 129             return '' unless (&IsParam("friendlyBots"));
 130
 131             foreach (split /\s+/, $param{'friendlyBots'}) {
 132                 &msg($_, ":INFOBOT:QUERY <$who> $query");
 133             }
 134         }
 135     }
 136
 137     $reply;
 138 }
 139
 140 1;