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