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/4.5 " . $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->content_type('application/x-www-form-urlencoded');
  76
  77   return translate($phrase, "${from}_${to}", $req, $ua);
  78 }
  79
  80 sub translate {
  81     return '' if $no_babel;
  82   my ($phrase, $languagepair, $req, $ua) = @_;
  83   &main::DEBUG("translate($phrase, $languagepair, $req, $ua)");
  84
  85   my $urltext = uri_escape($phrase);
  86   $req->content("urltext=$urltext&lp=$languagepair");
  87   &main::DEBUG("http://babelfish.altavista.com/babelfish/tr??urltext=$urltext&lp=$languagepair");
  88
  89   my $res = $ua->request($req);
  90   my $translated;
  91
  92   if ($res->is_success) {
  93       my $html = $res->content;
  94       # This method subject to change with the whims of Altavista's design
  95       # staff.
  96       ($translated) = $html;
  97
  98       $translated =~ s/<[^>]*>//sg;
  99       $translated =~ s/&nbsp;/ /sg;
 100       $translated =~ s/\s+/ /sg;
 101       #&main::DEBUG("$translated\n===remove <attributes>\n");
 102
 103       $translated =~ s/\s*Translate again.*//i;
 104       &main::DEBUG("$translated\n===remove after 'Translate again'\n");
 105
 106       $translated =~ s/[^:]*?:\s*(Help\s*)?//s;
 107       &main::DEBUG("$translated\n===remove to first ':', optional Help\n");
 108
 109       $translated =~ s/\n/ /g;
 110       # FIXME should we do unicode->iso
 111   } else {
 112       $translated = ":("; # failure
 113   }
 114   &main::pSReply($translated);
 115 }
 116
 117 if (0) {
 118     if (-t STDIN) {
 119         #my $result = babel::babelfish('en','sp','hello world');
 120         #my $result = babel::babelfish('en','sp','The cheese is old and moldy, where is the bathroom?');
 121         my $result = babel::babelfish('en','gr','doesn\'t seem to translate things longer than 40 characters');
 122         $result =~ s/; /\n/g;
 123         print "Babelfish says: \"$result\"\n";
 124     }
 125 }
 126
 127 1;