src/Modules/wikipedia.pl

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