Babelfish Mutations

Zen Master Nate writes "You are probably familiar with the BabelFish translation page, where you can enter a phrase and have it translated to or from several languages. Quickly. Inaccurately. This page automatically feeds the results back into the machine, resulting in exponentially erroneous translations. " I've been feeding it quotes from American Pie, Star Wars and Seinfeld. I should get out more.

Damn.

I did this a few months ago, but wasn't vain enough to submit it to /.. That'll learn me.

Here's the perl script, for anyone who's interested -- it hits bf once at the start, plus twice for each language available. Just enter an English phrase, and you'll see it translated to the other languages and back.

Some choice examples:

English: Why does the author use the phrase "kick-ass" constantly?
Italian: Why the author uses constantly the d of the phrase "soccer-ass"?

English: I chop down trees, I eat my lunch, I go to the lavatory. On Wednesdays I go shopping, and have buttered scones for tea!
Spanish: Edge under trees, I eat my I have lunch, I I go to the service. Wednesday I am going to make purchases, and I have scones greased with mantequilla for the tea!

English: I'll get you, and your little dog, too!
French: I will obtain you, and your puppy, therefore!
German: I receive you and your small dog, also!
Portuguese: I will start, and its small dog, too much!

English: No blood, no foul.
French: No blood, no stinking.
Spanish: No blood, no revolting one.

The source follows. /. won't let me use <PRE>, and I'm not going to format it by hand. Use "View Source" to copy/paste it.

cheers,
mike

#!/usr/bin/perl -w use Data::Dumper; use HTTP::Request::Common 'POST'; use LWP::Simple; use LWP::UserAgent; use HTML::TokeParser; $url='http://babelfish.altavista.com/cgi-bin/trans late'; print STDERR "Getting language list: "; $page=get $url; my $p=HTML::TokeParser->new(\$page); while ($toke=$p->get_tag("option")) { next unless $toke->[1]{value} =~ /^(\w\w)_en$/i; $lang=$1; ($name=$p->get_text) =~ s/ +to +English.*//is; push @langs,$lang; $names{$lang}=$name; print STDERR "$name "; } print STDERR "\n"; die "No languages found!\n" unless @langs; undef $/; $text=join ' ',@ARGV or ($text=`fortune`) =~ s/\n\s+--\s+.*\n\s*.*\n?$//; if (length $text > ($max=768)) { warn "Text longer than $max characters, truncating...\n"; $text=substr($text,0,$max); } die "Text must contain words!\n" unless $text=~/\w/; $text=~s/[.\s+]*$/./; printf "\e[1m%12s\e[0m: %s\n",'English',$text; foreach $lang (@langs) { printf "\e[1m%12s\e[0m: ",$names{$lang}; $trans=fetch($text,"en_$lang"); print fetch($trans,"$lang\_en"),"\n"; } sub fetch { my ($text,$lang)=@_; $text=~s/[.\s+]*$/. XYZZY./; my $ua = new LWP::UserAgent; $ua->env_proxy; my $req = POST $url, [ doit=>'done', urltext=>$text, lp=>$lang ]; my $page=$ua->request($req)->as_string; my $p=HTML::TokeParser->new(\$page); my $ok=''; my @tokes=(); my $toke=[]; while ($toke=$p->get_token and !$ok) { next unless $toke->[0] eq 'T' && $toke->[1]=~/\S/; $toke->[1] =~ s/\s+$//; $toke->[1] =~ s/^\s+//; push @tokes,$toke->[1]; $ok=$1 if $toke->[1]=~/(.*\S)\s*XYZZY\./s; } $ok=~s/\s+/ /g; die "Bad Response!\n". Dumper(\@tokes) . "\n" unless $ok; return $ok; } __END__