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