#!/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;
}