1 # This program is copyright Jonathan Feinberg 1999.
2 # This program is distributed under the same terms as infobot.
6 # http://pobox.com/~jdf/
9 # First public release.
11 # hacked by Tim@Rikers.org to handle new URL and layout
17 my $url = 'http://babelfish.av.com/tr';
20 eval "use URI::Escape"; # utility functions for encoding the
21 if ($@) { $no_babelfish++ }
23 eval "use LWP::UserAgent";
24 if ($@) { $no_babelfish++ }
29 # Translate some feasible abbreviations into the ones babelfish
31 use vars qw!%lang_code $lang_regex!;
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;
60 return '' if $no_babelfish;
61 my ( $from, $to, $phrase ) = @_;
62 &::DEBUG("babelfish($from, $to, $phrase)");
64 $from = $lang_code{$from};
65 $to = $lang_code{$to};
67 my $ua = new LWP::UserAgent;
68 $ua->proxy( 'http', $::param{'httpProxy'} ) if ( &::IsParam('httpProxy') );
71 $ua->agent( "Mozilla/5.0 " . $ua->agent );
74 my $req = HTTP::Request->new( 'POST', $url );
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');
83 return translate( $phrase, "${from}_${to}", $req, $ua );
87 return '' if $no_babelfish;
88 my ( $phrase, $languagepair, $req, $ua ) = @_;
89 &::DEBUG("translate($phrase, $languagepair, $req, $ua)");
91 my $trtext = uri_escape($phrase);
92 $req->content("trtext=$trtext&lp=$languagepair");
93 &::DEBUG("$url??trtext=$trtext&lp=$languagepair");
95 my $res = $ua->request($req);
98 if ( $res->is_success ) {
99 my $html = $res->content;
101 # This method subject to change with the whims of Altavista's design
103 ($translated) = $html;
105 $translated =~ s/<[^>]*>//sg;
106 $translated =~ s/ / /sg;
107 $translated =~ s/\s+/ /sg;
109 #&::DEBUG("$translated\n===remove <attributes>\n");
111 $translated =~ s/\s*Translate again.*//i;
112 &::DEBUG("$translated\n===remove after 'Translate again'\n");
114 $translated =~ s/[^:]*?:\s*(Help\s*)?//s;
116 . length($translated)
117 . " $translated\n===remove to first ':', optional Help\n" );
119 $translated =~ s/\n/ /g;
121 # FIXME: should we do unicode->iso (no. use utf8!)
124 $translated = ":("; # failure
126 $translated = "babelfish.pl: result too long, probably an error"
127 if ( length($translated) > 700 );
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";
138 ($babel_lang_regex)\w* # from language?
140 ($babel_lang_regex)\w* # to language?
142 (.+) # The phrase to be translated
146 &::performStrictReply( &babelfishParam( lc $1, lc $2, lc $3 ) );
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?');
157 babelfish::babelfish(
158 'en gr doesn\'t seem to translate things longer than 40 characters'
160 $result =~ s/; /\n/g;
161 print "Babelfish says: \"$result\"\n";
167 # vim:ts=4:sw=4:expandtab:tw=80