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 # hacked by Tim@Rikers.org to handle new URL and layout
  12
  13 package babel;
  14 use strict;
  15
  16 my $no_babel;
  17
  18 BEGIN {
  19     eval "use URI::Escape";    # utility functions for encoding the
  20     if ($@) { $no_babel++};    # babelfish request
  21     eval "use LWP::UserAgent";
  22     if ($@) { $no_babel++};
  23 }
  24
  25 BEGIN {
  26   # Translate some feasible abbreviations into the ones babelfish
  27   # expects.
  28     use vars qw!%lang_code $lang_regex!;
  29     %lang_code = (
  30                 'fr' => 'fr',
  31                 'sp' => 'es',
  32                 'es' => 'es',
  33                 'po' => 'pt',
  34                 'pt' => 'pt',
  35                 'it' => 'it',
  36                 'ge' => 'de',
  37                 'de' => 'de',
  38                 'gr' => 'de',
  39                 'en' => 'en',
  40                 'zh' => 'zh',
  41                 'ja' => 'ja',
  42                 'jp' => 'ja',
  43                 'ko' => 'ko',
  44                 'kr' => 'ko',
  45                 'nl' => 'nl',
  46                 'ru' => 'ru'
  47                );
  48
  49   # Here's how we recognize the language you're asking for.  It looks
  50   # like RTSL saves you a few keystrokes in #perl, huh?
  51   $lang_regex = join '|', keys %lang_code;
  52 }
  53
  54 sub babelfish {
  55     return '' if $no_babel;
  56   my ($from, $to, $phrase) = @_;
  57   &main::DEBUG("babelfish($from, $to, $phrase)");
  58
  59   $from = $lang_code{$from};
  60   $to = $lang_code{$to};
  61
  62   my $ua = new LWP::UserAgent;
  63   $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam("httpProxy"));
  64   # Let's pretend
  65   $ua->agent("Mozilla/5.0 " . $ua->agent);
  66   $ua->timeout(5);
  67
  68   my $req =
  69     #HTTP::Request->new('POST', 'http://babelfish.altavista.com/raging/translate.dyn');
  70     HTTP::Request->new('POST', 'http://babelfish.altavista.com/babelfish/tr');
  71
  72 # babelfish ignored this, but it SHOULD work
  73 # Accept-Charset: iso-8859-1
  74 #  $req->header('Accept-Charset' => 'iso-8859-1');
  75 #  print $req->header('Accept-Charset');
  76   $req->header('Accept-Language' => 'en');
  77   $req->content_type('application/x-www-form-urlencoded');
  78
  79   return translate($phrase, "${from}_${to}", $req, $ua);
  80 }
  81
  82 sub translate {
  83     return '' if $no_babel;
  84   my ($phrase, $languagepair, $req, $ua) = @_;
  85   &main::DEBUG("translate($phrase, $languagepair, $req, $ua)");
  86
  87   my $urltext = uri_escape($phrase);
  88   $req->content("urltext=$urltext&lp=$languagepair");
  89   &main::DEBUG("http://babelfish.altavista.com/babelfish/tr??urltext=$urltext&lp=$languagepair");
  90
  91   my $res = $ua->request($req);
  92   my $translated;
  93
  94   if ($res->is_success) {
  95       my $html = $res->content;
  96       # This method subject to change with the whims of Altavista's design
  97       # staff.
  98       ($translated) = $html;
  99
 100       $translated =~ s/<[^>]*>//sg;
 101       $translated =~ s/&nbsp;/ /sg;
 102       $translated =~ s/\s+/ /sg;
 103       #&main::DEBUG("$translated\n===remove <attributes>\n");
 104
 105       $translated =~ s/\s*Translate again.*//i;
 106       &main::DEBUG("$translated\n===remove after 'Translate again'\n");
 107
 108       $translated =~ s/[^:]*?:\s*(Help\s*)?//s;
 109       &main::DEBUG("$translated\n===remove to first ':', optional Help\n");
 110
 111       $translated =~ s/\n/ /g;
 112       # FIXME: should we do unicode->iso (no. use utf8!)
 113   } else {
 114       $translated = ":("; # failure
 115   }
 116   &main::pSReply($translated);
 117 }
 118
 119 if (0) {
 120     if (-t STDIN) {
 121         #my $result = babel::babelfish('en','sp','hello world');
 122         #my $result = babel::babelfish('en','sp','The cheese is old and moldy, where is the bathroom?');
 123         my $result = babel::babelfish('en','gr','doesn\'t seem to translate things longer than 40 characters');
 124         $result =~ s/; /\n/g;
 125         print "Babelfish says: \"$result\"\n";
 126     }
 127 }
 128
 129 1;