take a few more things literally

[infobot.git] / src / Modules / babelfish.pl

diff --git a/src/Modules/babelfish.pl b/src/Modules/babelfish.pl
index 6d3b0927d9a1f972690379140761f777775472c0..e7774cc8ea16c84e4b2f198302a63d3717ee6365 100644 (file)
--- a/src/Modules/babelfish.pl
+++ b/src/Modules/babelfish.pl
@@ -14,6 +14,7 @@ package babelfish;
 use strict;
 
 my $no_babelfish;
+my $url = 'http://babelfish.av.com/tr';
 
 BEGIN {
     eval "use URI::Escape";    # utility functions for encoding the
@@ -53,23 +54,21 @@ BEGIN {
   $lang_regex = join '|', keys %lang_code;
 }
 
-sub babelfish {
+sub babelfishParam {
     return '' if $no_babelfish;
   my ($from, $to, $phrase) = @_;
-  &main::DEBUG("babelfish($from, $to, $phrase)");
+  &::DEBUG("babelfish($from, $to, $phrase)");
 
   $from = $lang_code{$from};
   $to = $lang_code{$to};
 
   my $ua = new LWP::UserAgent;
-  $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam("httpProxy"));
+  $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam('httpProxy'));
   # Let's pretend
   $ua->agent("Mozilla/5.0 " . $ua->agent);
   $ua->timeout(5);
 
-  my $req =
-    #HTTP::Request->new('POST', 'http://babelfish.altavista.com/raging/translate.dyn');
-    HTTP::Request->new('POST', 'http://babelfish.altavista.com/babelfish/tr');
+  my $req = HTTP::Request->new('POST', $url);
 
 # babelfish ignored this, but it SHOULD work
 # Accept-Charset: iso-8859-1
@@ -84,47 +83,62 @@ sub babelfish {
 sub translate {
     return '' if $no_babelfish;
   my ($phrase, $languagepair, $req, $ua) = @_;
-  &main::DEBUG("translate($phrase, $languagepair, $req, $ua)");
+  &::DEBUG("translate($phrase, $languagepair, $req, $ua)");
 
-  my $urltext = uri_escape($phrase);
-  $req->content("urltext=$urltext&lp=$languagepair");
-  &main::DEBUG("http://babelfish.altavista.com/babelfish/tr??urltext=$urltext&lp=$languagepair");
+  my $trtext = uri_escape($phrase);
+  $req->content("trtext=$trtext&lp=$languagepair");
+  &::DEBUG("$url??trtext=$trtext&lp=$languagepair");
 
   my $res = $ua->request($req);
   my $translated;
 
   if ($res->is_success) {
-      my $html = $res->content;
-      # This method subject to change with the whims of Altavista's design
-      # staff.
-      ($translated) = $html;
+    my $html = $res->content;
+    # This method subject to change with the whims of Altavista's design
+    # staff.
+    ($translated) = $html;
 
-      $translated =~ s/<[^>]*>//sg;
-      $translated =~ s/&nbsp;/ /sg;
-      $translated =~ s/\s+/ /sg;
-      #&main::DEBUG("$translated\n===remove <attributes>\n");
+    $translated =~ s/<[^>]*>//sg;
+    $translated =~ s/&nbsp;/ /sg;
+    $translated =~ s/\s+/ /sg;
+    #&::DEBUG("$translated\n===remove <attributes>\n");
 
-      $translated =~ s/\s*Translate again.*//i;
-      &main::DEBUG("$translated\n===remove after 'Translate again'\n");
+    $translated =~ s/\s*Translate again.*//i;
+    &::DEBUG("$translated\n===remove after 'Translate again'\n");
 
-      $translated =~ s/[^:]*?:\s*(Help\s*)?//s;
-      &main::DEBUG("len=" . length($translated) . " $translated\n===remove to first ':', optional Help\n");
+    $translated =~ s/[^:]*?:\s*(Help\s*)?//s;
+    &::DEBUG("len=" . length($translated) . " $translated\n===remove to first ':', optional Help\n");
 
-      $translated =~ s/\n/ /g;
-      # FIXME: should we do unicode->iso (no. use utf8!)
+    $translated =~ s/\n/ /g;
+    # FIXME: should we do unicode->iso (no. use utf8!)
   } else {
-      $translated = ":("; # failure
+    $translated = ":("; # failure
   }
   $translated = "babelfish.pl: result too long, probably an error" if (length($translated) > 700);
 
-  &main::pSReply($translated);
+  return $translated
+}
+
+sub babelfish {
+  my ($message) = @_;
+  my $babel_lang_regex = "de|ge|gr|el|sp|es|en|fr|it|ja|jp|ko|kr|nl|po|pt|ru|zh|zt";
+  if ($message =~ m{
+    ($babel_lang_regex)\w*     # from language?
+    \s+
+    ($babel_lang_regex)\w*     # to language?
+    \s*
+    (.+)                       # The phrase to be translated
+  }xoi) {
+    &::performStrictReply(&babelfishParam(lc $1, lc $2, lc $3));
+  }
+  return;
 }
 
 if (0) {
     if (-t STDIN) {
-       #my $result = babelfish::babelfish('en','sp','hello world');
-       #my $result = babelfish::babelfish('en','sp','The cheese is old and moldy, where is the bathroom?');
-       my $result = babelfish::babelfish('en','gr','doesn\'t seem to translate things longer than 40 characters');
+       #my $result = babelfish::babelfish('en sp hello world');
+       #my $result = babelfish::babelfish('en sp The cheese is old and moldy, where is the bathroom?');
+       my $result = babelfish::babelfish('en gr doesn\'t seem to translate things longer than 40 characters');
        $result =~ s/; /\n/g;
        print "Babelfish says: \"$result\"\n";
     }