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     return unless &::loadPerlModule("LWP::UserAgent");
  40
  41     $lang = $lang_code{$lang};
  42
  43     my $ua = new LWP::UserAgent;
  44     $ua->timeout(10);
  45     $ua->proxy('http', $::param{'httpProxy'}) if &::IsParam("httpProxy");
  46
  47     my $url = 'http://babelfish.altavista.com/raging/translate.dyn';
  48     my $req = HTTP::Request->new('POST',$url);
  49
  50     $req->content_type('application/x-www-form-urlencoded');
  51
  52     my $tolang = "en_$lang";
  53     my $toenglish = "${lang}_en";
  54
  55     if ($direction eq 'to') {
  56         my $xlate = translate($phrase, $tolang, $req, $ua);
  57         &::pSReply($xlate) if ($xlate);
  58         return;
  59     } elsif ($direction eq 'from') {
  60         my $xlate = translate($phrase, $toenglish, $req, $ua);
  61         &::pSReply($xlate) if ($xlate);
  62         return;
  63     }
  64     &DEBUG("what's this junk?");
  65
  66     my $last_english = $phrase;
  67     my $last_lang;
  68     my %results = ();
  69     my $i = 0;
  70     while ($i++ < 7) {
  71         last if $results{$phrase}++;    # REMOVE!
  72         $last_lang = $phrase = translate($phrase, $tolang, $req, $ua);
  73         last if $results{$phrase}++;    # REMOVE!
  74         $last_english = $phrase = translate($phrase, $toenglish, $req, $ua);
  75     }
  76
  77     &::pSReply($last_english);
  78 }
  79
  80 sub translate {
  81     my ($phrase, $languagepair, $req, $ua) = @_;
  82
  83     my $urltext = URI::Escape::uri_escape($phrase);
  84     $req->content("urltext=$urltext&lp=$languagepair&doit=done");
  85
  86     my $res = $ua->request($req);
  87
  88     my $translated;
  89     if ($res->is_success) {             # success.
  90         my $html = $res->content;
  91         my $textarea    = 0;
  92         foreach (split "\n", $html) {
  93             $textarea   = 1     if (/<textarea/i);
  94             next unless ($textarea);
  95
  96             &DEBUG("   '$_'");
  97
  98             $textarea   = 0     if (/<\/textarea/i);
  99         }
 100
 101         $html   =~ s/\cM//g;
 102         $html   =~ s/\n\s*\n/\n/g;
 103         $html   =~ s/\n/ /g;    # ...
 104
 105         if ($html =~ /<textarea.*?>(.*?)<\/textarea/si) {
 106             $translated = $1;
 107             $translated =~ s/^[\n ]|[\n ]$//g;
 108         } else {
 109             &::WARN("failed regex for babelfish.");
 110         }
 111
 112     } else {                            # failure
 113         $translated = "FAILURE w/ babelfish";
 114     }
 115
 116     $translated ||= "NULL reply from babelfish.";
 117
 118     return $translated;
 119 }
 120
 121 1;