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     $req->header('Accept-Language' => 'en-us');
  78     $req->header('Accept-Charset' => 'UTF-8,*');
  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     &::DEBUG("translate($phrase, $languagepair, $req, $ua)");
  88
  89     my $trtext = uri_escape($phrase);
  90     $req->content("trtext=$trtext&lp=$languagepair");
  91     &::DEBUG("$url??trtext=$trtext&lp=$languagepair");
  92
  93     my $res = $ua->request($req);
  94     my $translated;
  95
  96     if ( $res->is_success ) {
  97         my $html = $res->content;
  98
  99         # This method subject to change with the whims of Babelfish design staff.
 100         ($translated) = $html;
 101         # strip page head
 102         $translated =~ s/.*<\/head>//sg;
 103         # clean before doc-body
 104         $translated =~ s/.*<div id="doc-body"[^>]*>//sg;
 105         # clean after first form
 106         $translated =~ s/<\/form>.*//sg;
 107         # convert back to spaces
 108         $translated =~ s/&nbsp;/ /sg;
 109         &::DEBUG("================================\n$translated\n========================\n");
 110         # strip up to result
 111         $translated =~ s/.*<div id="result">//sg;
 112         # strip rest of page
 113         $translated =~ s/<\/div.*//sg;
 114         # strip all markup
 115         $translated =~ s/<[^>]*>/ /sg;
 116         # \n to space
 117         $translated =~ s/[\n\r\t]/ /g;
 118         # strip leading whitespace
 119         $translated =~ s/^\s+//sg;
 120         # strip trailing whitespace
 121         $translated =~ s/\s+$//sg;
 122         # strip multiple whitespace
 123         $translated =~ s/\s+/ /sg;
 124
 125         # FIXME: any entities to utf8?
 126     }
 127     else {
 128         $translated = ":(";    # failure
 129     }
 130     $translated = "babelfish.pl: result too long, probably an error"
 131       if ( length($translated) > 700 );
 132
 133     return $translated;
 134 }
 135
 136 sub babelfish {
 137     my ($message) = @_;
 138     my $babel_lang_regex =
 139       "de|ge|gr|el|sp|es|en|fr|it|ja|jp|ko|kr|nl|po|pt|ru|zh|zt";
 140     if (
 141         $message =~ m{
 142     ($babel_lang_regex)\w*      # from language?
 143     \s+
 144     ($babel_lang_regex)\w*      # to language?
 145     \s*
 146     (.+)                        # The phrase to be translated
 147   }xoi
 148       )
 149     {
 150         &::performStrictReply( &babelfishParam( lc $1, lc $2, lc $3 ) );
 151     }
 152     return;
 153 }
 154
 155 1;
 156
 157 # vim:ts=4:sw=4:expandtab:tw=80