src/Modules/wikipedia.pl

   1 # This program is distributed under the same terms as infobot.
   2
   3 package wikipedia;
   4 use strict;
   5
   6 my $missing;
   7 my $wikipedia_base_url = 'http://www.wikipedia.org/wiki/';
   8 my $wikipedia_search_url = $wikipedia_base_url . 'Special:Search?';
   9 my $wikipedia_export_url = $wikipedia_base_url . 'Special:Export/';
  10
  11 BEGIN {
  12   # utility functions for encoding the wikipedia request
  13   eval "use URI::Escape";
  14   if ($@) {
  15     $missing++;
  16   }
  17
  18   eval "use LWP::UserAgent";
  19   if ($@) {
  20     $missing++;
  21   }
  22
  23   eval "use HTML::Entities";
  24   if ($@) {
  25     $missing++;
  26   }
  27 }
  28
  29 sub wikipedia {
  30   return '' if $missing;
  31   my ($phrase) = @_;
  32   my ($reply, $valid_result) = wikipedia_lookup(@_);
  33   if ($reply) {
  34     &::performStrictReply($reply);
  35   } else {
  36     &::performStrictReply("'$phrase' not found in Wikipedia. Perhaps try a different spelling or case?");
  37   }
  38 }
  39
  40 sub wikipedia_silent {
  41   return '' if $missing;
  42   my ($reply, $valid_result) = wikipedia_lookup(@_);
  43   if ($valid_result and $reply) {
  44     &::performStrictReply($reply);
  45   }
  46 }
  47
  48 sub wikipedia_lookup {
  49   my ($phrase) = @_;
  50   &::DEBUG("wikipedia($phrase)");
  51
  52   my $ua = new LWP::UserAgent;
  53   $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam('httpProxy'));
  54   # Let's pretend
  55   $ua->agent("Mozilla/5.0 " . $ua->agent);
  56   $ua->timeout(5);
  57
  58   # chop ? from the end
  59   $phrase =~ s/\?$//;
  60   # convert phrase to wikipedia conventions
  61 #  $phrase = uri_escape($phrase);
  62 #  $phrase =~ s/%20/+/g;
  63 #  $phrase =~ s/%25/%/g;
  64   $phrase =~ s/ /+/g;
  65
  66   # using the search form will make the request case-insensitive
  67   # HEAD will follow redirects, catching the first mode of redirects
  68   # that wikipedia uses
  69   my $url = $wikipedia_search_url . 'search=' . $phrase . '&go=Go';
  70   my $req = HTTP::Request->new('HEAD', $url);
  71   $req->header('Accept-Language' => 'en');
  72   &::DEBUG($url);
  73
  74   my $res = $ua->request($req);
  75   &::DEBUG($res->code);
  76
  77   if (!$res->is_success) {
  78     return("Wikipedia might be temporarily unavailable (".$res->code."). Please try again in a few minutes...",
  79            0);
  80   } else {
  81     # we have been redirected somewhere
  82     # (either content or the generic Search form)
  83     # let's find the title of the article
  84     $url = $res->request->uri;
  85     $phrase = $url;
  86     $phrase =~ s/.*\/wiki\///;
  87
  88     if (!$res->code == '200') {
  89       return("Wikipedia might be temporarily unavailable or something is broken (".$res->code."). Please try again later...",
  90              0);
  91     } else {
  92       if ($url =~ m/Special:Search/) {
  93         # we were sent to the the search page
  94         return("I couldn't find a matching article in wikipedia, look for yerselves: " . $url,
  95                0);
  96       } else {
  97         # we hit content, let's retrieve it
  98         my $text = wikipedia_get_text($phrase);
  99
 100         # filtering unprintables
 101         $text =~ s/[[:cntrl:]]//g;
 102         # filtering headings
 103         $text =~ s/==+[^=]*=+//g;
 104         # filtering wikipedia tables
 105         $text =~ s/\{\|[^}]+\|\}//g;
 106         # some people cannot live without HTML tags, even in a wiki
 107         # $text =~ s/&lt;div.*&gt;//gi;
 108         # $text =~ s/&lt;!--.*&gt;//gi;
 109         # $text =~ s/<[^>]*>//g;
 110         # or HTML entities
 111         $text =~ s/&amp;/&/g;
 112         decode_entities($text);
 113         # or tags, again
 114         $text =~ s/<[^>]*>//g;
 115         #$text =~ s/[&#]+[0-9a-z]+;//gi;
 116         # filter wikipedia tags: [[abc: def]]
 117         $text =~ s/\[\[[[:alpha:]]*:[^]]*\]\]//gi;
 118         # {{abc}}:tag
 119         $text =~ s/\{\{[[:alpha:]]+\}\}:[^\s]+//gi;
 120         # {{abc}}
 121         $text =~ s/\{\{[[:alpha:]]+\}\}//gi;
 122         # unescape quotes
 123         $text =~ s/'''/'/g;
 124         $text =~ s/''/"/g;
 125         # filter wikipedia links: [[tag|link]] -> link
 126         $text =~ s/\[\[[^]]+\|([^]]+)\]\]/$1/g;
 127         # [[link]] -> link
 128         $text =~ s/\[\[([^]]+)\]\]/$1/g;
 129         # shrink whitespace
 130         $text =~ s/[[:space:]]+/ /g;
 131         # chop leading whitespace
 132         $text =~ s/^ //g;
 133
 134         # shorten article to first one or two sentences
 135         # new: we rely on the output function to know what to do
 136         #      with long messages
 137         #$text = substr($text, 0, 330);
 138         #$text =~ s/(.+)\.([^.]*)$/$1./g;
 139
 140         return('At ' . $url . " (URL), Wikipedia explains: " . $text,
 141                1);
 142       }
 143     }
 144   }
 145 }
 146
 147 sub wikipedia_get_text {
 148   return '' if $missing;
 149   my ($article) = @_;
 150   &::DEBUG("wikipedia_get_text($article)");
 151
 152   my $ua = new LWP::UserAgent;
 153   $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam('httpProxy'));
 154   # Let's pretend
 155   $ua->agent("Mozilla/5.0 " . $ua->agent);
 156   $ua->timeout(5);
 157
 158   &::DEBUG($wikipedia_export_url . $article);
 159   my $req = HTTP::Request->new('GET', $wikipedia_export_url .
 160                                $article);
 161   $req->header('Accept-Language' => 'en');
 162   $req->header('Accept-Charset' => 'utf-8');
 163
 164   my $res = $ua->request($req);
 165   my ($title, $redirect, $text);
 166   &::DEBUG($res->code);
 167
 168   if ($res->is_success) {
 169     if ($res->code == '200' ) {
 170       foreach (split(/\n/, $res->as_string)) {
 171         if (/<title>(.*?)<\/title>/) {
 172           $title = $1;
 173           $title =~ s/&amp\;/&/g;
 174         } elsif (/#REDIRECT\s*\[\[(.*?)\]\]/i) {
 175           $redirect = $1;
 176           $redirect =~ tr/ /_/;
 177           &::DEBUG('wiki redirect to ' . $redirect);
 178           last;
 179         } elsif (/<text[^>]*>(.*)/) {
 180           $text = '"' . $1;
 181         } elsif (/(.*)<\/text>/) {
 182           $text = $text . ' ' . $1 . '"';
 183           last;
 184         } elsif ($text) {
 185           $text = $text . ' ' . $_;
 186         }
 187       }
 188       &::DEBUG("wikipedia returned text: " . $text .
 189                    ', redirect ' . $redirect. "\n");
 190
 191       if (!$redirect and !$text) {
 192         return ($res->as_string);
 193       }
 194       return ($text or wikipedia_get_text($redirect))
 195     }
 196   }
 197
 198 }
 199
 200 1;