src/Modules/babel.pl

   1 # This program is copyright Jonathan Feinberg 1999.
   2 # This program is distributed under the same terms as infobot.
   3
   4 # Jonathan Feinberg
   5 # jdf@pobox.com
   6 # http://pobox.com/~jdf/
   7
   8 # Version 1.0
   9 # First public release.
  10
  11 package babel;
  12 use strict;
  13
  14 BEGIN {
  15     # Translate some feasible abbreviations into the ones babelfish
  16     # expects.
  17     use vars qw!%lang_code $lang_regex!;
  18     %lang_code = (
  19                 'fr' => 'fr',
  20                 'sp' => 'es',
  21                 'po' => 'pt',
  22                 'pt' => 'pt',
  23                 'it' => 'it',
  24                 'ge' => 'de',
  25                 'de' => 'de',
  26                 'gr' => 'de',
  27                 'en' => 'en'
  28                );
  29
  30     # Here's how we recognize the language you're asking for.  It looks
  31     # like RTSL saves you a few keystrokes in #perl, huh?
  32     $lang_regex = join '|', keys %lang_code;
  33 }
  34
  35 sub babelfish {
  36     my ($direction, $lang, $phrase) = @_;
  37
  38     return unless &loadPerlModule("URI::Escape");
  39
  40     $lang = $lang_code{$lang};
  41
  42     my $ua = new LWP::UserAgent;
  43     $ua->timeout(10);
  44
  45     my $url = 'http://babelfish.altavista.digital.com/cgi-bin/translate';
  46     my $req = HTTP::Request->new('POST',$url);
  47     $req->content_type('application/x-www-form-urlencoded');
  48
  49     my $tolang = "en_$lang";
  50     my $toenglish = "${lang}_en";
  51
  52     if ($direction eq 'to') {
  53         &main::performStrictReply( translate($phrase, $tolang, $req, $ua) );
  54         return;
  55     } elsif ($direction eq 'from') {
  56         &main::performStrictReply( translate($phrase, $toenglish, $req, $ua) );
  57         return;
  58     }
  59
  60     my $last_english = $phrase;
  61     my $last_lang;
  62     my %results = ();
  63     my $i = 0;
  64     while ($i++ < 7) {
  65         last if $results{$phrase}++;
  66         $last_lang = $phrase = translate($phrase, $tolang, $req, $ua);
  67         last if $results{$phrase}++;
  68         $last_english = $phrase = translate($phrase, $toenglish, $req, $ua);
  69     }
  70
  71     &main::performStrictReply($last_english);
  72 }
  73
  74 sub translate {
  75     return '' if $no_babel;
  76     my ($phrase, $languagepair, $req, $ua) = @_;
  77
  78     my $urltext = uri_escape($phrase);
  79     $req->content("urltext=$urltext&lp=$languagepair&doit=done");
  80
  81     my $res = $ua->request($req);
  82
  83     my $translated;
  84     if ($res->is_success) {             # success.
  85         my $html = $res->content;
  86         # This method subject to change with the whims of Altavista's design
  87         # staff.
  88
  89         $translated =
  90           ($html =~ m{<br>
  91                           \s+
  92                               <font\ face="arial,\ helvetica">
  93                                   \s*
  94                                       (?:\*\*\s+time\ out\s+\*\*)?
  95                                           \s*
  96                                               ([^<]*)
  97                                               }sx);
  98
  99         $translated =~ s/\n/ /g;
 100         $translated =~ s/\s*$//;
 101     } else {                            # failure
 102         $translated = ":(";
 103     }
 104
 105     return $translated;
 106 }
 107
 108 1;