Chained Babelfish Translations

[merlyn]

Category:

CGI Programming

Description:

The Babelfish service at Altavista is cool, but it's really fun to drag some random text to and from weird languages to see how much "it loses in the translation". So I wrote a nice short program for an upcoming Linux Magazine column to automate the chaining from one language to the next, showing the intermediate results. 95 lines (again {grin}).

This code is a review draft from a forthcoming Linux Magazine Perl column and is provided for review purposes only. Further copying and redistribution is not permitted. You can download this and put it on your site to use it for "evaluation purposes", but you cannot redistribute the source out of context. Once the magazine releases the code, in about three months, you can download it from my official site and do with it what you want. I'm sorry for being more restrictive than most open source stuff, but this is "work for hire", and I have to be careful.

#!/usr/bin/perl -Tw
# copyright (c) 2000, Randal L. Schwartz for Linux Magazine
# this draft provided for review purposes only
use strict;
$|++;

my %LANGUAGES = qw(
  en English
  fr French
  ge German
  it Italian
  po Portuguese
  ru Russian
  sp Spanish
);

my %PERMITTED;
$PERMITTED{$_}++ for qw(
  enfr enge enit enpo ensp fren geen iten poen ruen spen frge gefr
);

use CGI qw(:all *table *Tr escapeHTML);

print header, start_html('babel linker'), h1('babel linker');

print                # text area form, translate button:
  start_form,
  submit('translate'),
  textarea('text', "My hovercraft is full of eels!", 4, 50),
  end_form;

my $translate_wanted = defined param('translate');
Delete('translate');        # so language-changing URLs don't trigger

(my $pi = path_info()) =~ m{^/}g; # skip past leading slash if present

my @path = $pi =~ /\G(@{[join "|", keys %LANGUAGES]})/g;
@path = qw(en ge) unless @path;    # default to english-to-german if n
+o path

## start of language selection matrix...
print
  start_table({border => 0, cellspacing => 0, cellpadding => 2}),
  start_Tr;

my $pathstring = url()."/";

my @links = ("",@path,"");
while (@links > 1) {
  my ($from, $to) = @links;    # first two, ignore rest for now
  print
    td($from ? $to ? "to" : "and then to" : "from"),
      td(links($pathstring, $from, $to));
  $pathstring .= $to;
  shift @links;
}

print end_Tr, end_table;
## ...end of language selection matrix

## now do the translation if needed:
if ($translate_wanted and @path > 1) {
  require WWW::Babelfish;
  my $text = param('text');
  my $linguist = WWW::Babelfish->new or die "no linguist";

  print start_table({border => 0, cellspacing => 0, cellpadding => 3})
+;
  while (@path > 1) {
    my ($src, $dst) = @path;    # first two elements, rest ignored for
+ now
    $_ = $LANGUAGES{$_} for $src, $dst;
    my $result = $linguist->
      translate(source => $src, destination => $dst, text => $text);
    print Tr(td("... from $src to $dst becomes ..."),
         td(defined $result ? escapeHTML($result) :
        "... unintelligible (aborting) ..."));
    last unless defined $result;
    shift @path;        # slide it over
    $text = $result;
  }
  print end_table;

}

print end_html;

sub links {
  my ($path, $from, $to) = @_;
  my @permitted = sort keys %LANGUAGES;

  ## strip bogus combos if this isn't the first in the chain:
  @permitted = grep { exists $PERMITTED{"$from$_"} } @permitted if $fr
+om;

  return map {
    my $lang = $LANGUAGES{$_};
    ($_ eq $to) ? b($lang) :
      a({-href => "$path$_?".query_string()}, $lang), br;
  } @permitted;
}