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