src/Modules/babel.pl

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