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                 'ru' => 'ru'
  46                );
  47
  48   # Here's how we recognize the language you're asking for.  It looks
  49   # like RTSL saves you a few keystrokes in #perl, huh?
  50   $lang_regex = join '|', keys %lang_code;
  51 }
  52
  53 sub babelfish {
  54     return '' if $no_babel;
  55   my ($from, $to, $phrase) = @_;
  56   &main::DEBUG("babelfish($from, $to, $phrase)");
  57
  58   $from = $lang_code{$from};
  59   $to = $lang_code{$to};
  60
  61   my $ua = new LWP::UserAgent;
  62   $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam("httpProxy"));
  63   # Let's pretend
  64   $ua->agent("Mozilla/5.0 " . $ua->agent);
  65   $ua->timeout(5);
  66
  67   my $req =
  68     #HTTP::Request->new('POST', 'http://babelfish.altavista.com/raging/translate.dyn');
  69     HTTP::Request->new('POST', 'http://babelfish.altavista.com/babelfish/tr');
  70
  71 # babelfish ignored this, but it SHOULD work
  72 # Accept-Charset: iso-8859-1
  73 #  $req->header('Accept-Charset' => 'iso-8859-1');
  74 #  print $req->header('Accept-Charset');
  75   $req->header('Accept-Language' => 'en');
  76   $req->content_type('application/x-www-form-urlencoded');
  77
  78   return translate($phrase, "${from}_${to}", $req, $ua);
  79 }
  80
  81 sub translate {
  82     return '' if $no_babel;
  83   my ($phrase, $languagepair, $req, $ua) = @_;
  84   &main::DEBUG("translate($phrase, $languagepair, $req, $ua)");
  85
  86   my $urltext = uri_escape($phrase);
  87   $req->content("urltext=$urltext&lp=$languagepair");
  88   &main::DEBUG("http://babelfish.altavista.com/babelfish/tr??urltext=$urltext&lp=$languagepair");
  89
  90   my $res = $ua->request($req);
  91   my $translated;
  92
  93   if ($res->is_success) {
  94       my $html = $res->content;
  95       # This method subject to change with the whims of Altavista's design
  96       # staff.
  97       ($translated) = $html;
  98
  99       $translated =~ s/<[^>]*>//sg;
 100       $translated =~ s/&nbsp;/ /sg;
 101       $translated =~ s/\s+/ /sg;
 102       #&main::DEBUG("$translated\n===remove <attributes>\n");
 103
 104       $translated =~ s/\s*Translate again.*//i;
 105       &main::DEBUG("$translated\n===remove after 'Translate again'\n");
 106
 107       $translated =~ s/[^:]*?:\s*(Help\s*)?//s;
 108       &main::DEBUG("$translated\n===remove to first ':', optional Help\n");
 109
 110       $translated =~ s/\n/ /g;
 111       # FIXME: should we do unicode->iso (no. use utf8!)
 112   } else {
 113       $translated = ":("; # failure
 114   }
 115   &main::pSReply($translated);
 116 }
 117
 118 if (0) {
 119     if (-t STDIN) {
 120         #my $result = babel::babelfish('en','sp','hello world');
 121         #my $result = babel::babelfish('en','sp','The cheese is old and moldy, where is the bathroom?');
 122         my $result = babel::babelfish('en','gr','doesn\'t seem to translate things longer than 40 characters');
 123         $result =~ s/; /\n/g;
 124         print "Babelfish says: \"$result\"\n";
 125     }
 126 }
 127
 128 1;