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 #my $url = 'http://babelfish.av.com/tr';
  18 my $url = 'http://babelfish.yahoo.com/translate_txt';
  19
  20 BEGIN {
  21     eval "use URI::Escape";    # utility functions for encoding the
  22     if ($@) { $no_babelfish++ }
  23     ;                          # babelfish request
  24     eval "use LWP::UserAgent";
  25     if ($@) { $no_babelfish++ }
  26 }
  27
  28 BEGIN {
  29
  30     # Translate some feasible abbreviations into the ones babelfish
  31     # expects.
  32     use vars qw!%lang_code $lang_regex!;
  33     %lang_code = (
  34         'de' => 'de',
  35         'ge' => 'de',
  36         'gr' => 'el',
  37         'el' => 'el',
  38         'sp' => 'es',
  39         'es' => 'es',
  40         'en' => 'en',
  41         'fr' => 'fr',
  42         'it' => 'it',
  43         'ja' => 'ja',
  44         'jp' => 'ja',
  45         'ko' => 'ko',
  46         'kr' => 'ko',
  47         'nl' => 'nl',
  48         'po' => 'pt',
  49         'pt' => 'pt',
  50         'ru' => 'ru',
  51         'zh' => 'zh',
  52         'zt' => 'zt'
  53     );
  54
  55     # Here's how we recognize the language you're asking for.  It looks
  56     # like RTSL saves you a few keystrokes in #perl, huh?
  57     $lang_regex = join '|', keys %lang_code;
  58 }
  59
  60 sub babelfishParam {
  61     return '' if $no_babelfish;
  62     my ( $from, $to, $phrase ) = @_;
  63     &::DEBUG("babelfish($from, $to, $phrase)");
  64
  65     $from = $lang_code{$from};
  66     $to   = $lang_code{$to};
  67
  68     my $ua = new LWP::UserAgent;
  69     $ua->proxy( 'http', $::param{'httpProxy'} ) if ( &::IsParam('httpProxy') );
  70
  71     # Let's pretend
  72     $ua->agent( "Mozilla/5.0 " . $ua->agent );
  73     $ua->timeout(5);
  74
  75     my $req = HTTP::Request->new( 'POST', $url );
  76
  77     # babelfish ignored this, but it SHOULD work
  78     # Accept-Charset: iso-8859-1
  79     #  $req->header('Accept-Charset' => 'iso-8859-1');
  80     #  print $req->header('Accept-Charset');
  81     $req->header( 'Accept-Language' => 'en' );
  82     $req->content_type('application/x-www-form-urlencoded');
  83
  84     return translate( $phrase, "${from}_${to}", $req, $ua );
  85 }
  86
  87 sub translate {
  88     return '' if $no_babelfish;
  89     my ( $phrase, $languagepair, $req, $ua ) = @_;
  90     &::DEBUG("translate($phrase, $languagepair, $req, $ua)");
  91
  92     my $trtext = uri_escape($phrase);
  93     $req->content("trtext=$trtext&lp=$languagepair");
  94     &::DEBUG("$url??trtext=$trtext&lp=$languagepair");
  95
  96     my $res = $ua->request($req);
  97     my $translated;
  98
  99     if ( $res->is_success ) {
 100         my $html = $res->content;
 101
 102         # This method subject to change with the whims of Babelfish design staff.
 103         ($translated) = $html;
 104         # strip page head
 105         $translated =~ s/.*<\/head>//sg;
 106         &::DEBUG("================================\n$translated\n========================\n");
 107         # convert back to spaces
 108         $translated =~ s/&nbsp;/ /sg;
 109         # strip multiple whitespace
 110         $translated =~ s/\s+/ /sg;
 111         # strip up to result
 112         $translated =~ s/.*<div id="result">//sg;
 113         # strip rest of page
 114         $translated =~ s/<\/div.*//sg;
 115         # strip all markup
 116         $translated =~ s/<[^>]*>//sg;
 117         # \n to space
 118         $translated =~ s/\n/ /g;
 119         # strip multiple whitespace
 120         $translated =~ s/\s+/ /sg;
 121
 122         # FIXME: any entities to utf8?
 123     }
 124     else {
 125         $translated = ":(";    # failure
 126     }
 127     $translated = "babelfish.pl: result too long, probably an error"
 128       if ( length($translated) > 700 );
 129
 130     return $translated;
 131 }
 132
 133 sub babelfish {
 134     my ($message) = @_;
 135     my $babel_lang_regex =
 136       "de|ge|gr|el|sp|es|en|fr|it|ja|jp|ko|kr|nl|po|pt|ru|zh|zt";
 137     if (
 138         $message =~ m{
 139     ($babel_lang_regex)\w*      # from language?
 140     \s+
 141     ($babel_lang_regex)\w*      # to language?
 142     \s*
 143     (.+)                        # The phrase to be translated
 144   }xoi
 145       )
 146     {
 147         &::performStrictReply( &babelfishParam( lc $1, lc $2, lc $3 ) );
 148     }
 149     return;
 150 }
 151
 152 1;
 153
 154 # vim:ts=4:sw=4:expandtab:tw=80