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