Category: | CGI Programming |
Author/Contact Info | Randal L. Schwartz - merlyn |
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; } |
Back to
Code Catacombs