Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

Acme::Translator

by OeufMayo (Curate)
on May 28, 2001 at 01:23 UTC ( #83644=CUFP: print w/ replies, xml ) Need Help??

Ahaha! Babelfish here I come! Fear the sheer power of an incredible, award-winning translator!

Amaze your friends and impress women with this state-of-the-art program. 5 (five!) languages included, and more to come. Satisfaction guaranteed or you'll get your money back!


Here are 100% true testimonies of the success of Acme::Translator:

mpolo
Before I used Acme::Translator, I was never able to speak to a Russian in his own language!(Of course, after I tried it, I still couldn't...) :-)

Big ++ goes also to Beatnik, Jouke, ar0n, virtualsue,Tiefling and the few people around the CB today!

and yes I like using exclamation marks!

Update 2001-06-01: added epoptai suggestions and the russian s/\be/ye/

I know I got you hooked, so...

#!/usr/bin/perl -Tw $|++; use strict; use CGI; use LWP::Simple 'get'; use HTML::Munger; use Text::Bastardize; use vars qw($VERSION); $VERSION = 0.01; # just to annoy Jouke my %languages = ( spanish => 1, russian => 1, dutch => 1, french => 1, k3wlt0k => 1, pig => 1, ); my $q = new CGI; my $location = $q->url(); if (!$q->param('url') && !$q->param('text') ){ print $q->header(), $q->start_html('Acme::Translator'), $q->h1('Acme::Translator'), $q->start_form(-method=>'get'), $q->p('Enter a URL, or Text with no URL, to translate:'), $q->p("URL ", $q->textfield('url','http://','45'), $q->submit('Translate!')), $q->p($q->radio_group( 'language', [keys %languages], 'russian')), $q->p("Text<br>", $q->textarea('text','','10','60')), $q->end_form, $q->p("'k3wlt0k' and 'pig' are just hooks to the Text::B +astardize function"), $q->p("Remove the URL to translate what's in the textare +a"), $q->end_html; } else { print $q->header(); my $munger = new HTML::Munger; my $transto = $q->param('language'); if ($q->param('url')){ if (exists $languages{$transto}){ no strict 'refs'; # *cough cough* $munger->set_munger(\&{$transto}) } else {$munger->set_munger(\&russian) } my $url = $q->param('url'); my $input = get( $url ); my $output = $munger->munge($url, "$location?language=$transto +&url=", $input); print $output; } else { if (exists $languages{$transto}){ no strict 'refs'; # *cough cough* print &{$transto}($q->param('text')); } else { print &russian($q->param('text')); } } } sub pig { my $text = new Text::Bastardize; $text->charge(shift()); my ($out) = $text->pig(); return $out; } sub k3wlt0k { my $text = new Text::Bastardize; $text->charge(shift()); my ($out) = $text->k3wlt0k(); return $out; } sub dutch { $_ = shift; s/x/ks/gi; s/\ba(?:n)\b/een/gi; s/\bof\b/van/gi; s/\band\b/en/gi; s/\bmy\b/mijn/gi; s/\bif\b/als/gi; s/\bnow\b/nu/gi; s/\bwith\b/met/gi; s/\by/j/gi; s/\bI\b/ik/gi; s/(eo|y|ea)/ie/gi; s/ay/ee/gi; s/\bthat\b/dat/gi; s/\bnot\b/niet/gi; s/\byes\b/ja/gi; s/\bthe\b/rand > 0.50 ? 'het' : 'de'/gie; s/\b(\w{4,})([aei])?s\b(?!['&])/rand > 0.2 ? "$1en" : "$1$2s"/gie; s/c(?![^aeiou])/rand > 0.10 ? 'k' : 'c'/gie; s/ph/rand > 0.40 ? 'f' : 'ph'/gie; s/ew/euw/gi; s/([oeu])/rand > 0.9 ? "$1$1" : "$1"/gie; s/([ou])\1\1/$1$1/i; s/ee/ie/gi; s/ou/oe/gi; s/(?:^|\b)(\w+)([^'&;\s])\b(?!['&;])/ if (length($1.$2) > 5){ my $r=rand; $1 . $2 . ( $r > .90 ? 'er' : $r > .85 ? 'en' : $r > .77 ? 'tie' : $r > .65 ? 'ing' : '' ) } else { $1.$2 } /egix; return $_; } sub french { #pseudo-french $_ = shift; s/\bvery\b/tr&egrave;s/ig; s/\bother\b/autre/ig; s/\bwhere\b/o&ugrave;/ig; s/\bwell\b/bien/gi; s/\bof\b/de/gi; s/\bHow\b/comment/gi; s/\bare\b/sont/gi; if ((/\bthe\b/i) && (rand > 0.5)){ s/\bthe\b/le/; } else { s/\bthe\b/la/; }; s/th/z/g; s/Th/Z/g; s/er/eur/gi; s/oo/ou/gi; s/\bde el\b/du/gi; return $_; } sub russian { #pseudo-russianski $_ = shift; s/\byes\b/da/gi; s/\bno\b/nyet/gi; s/th/d/gi; s/have/havink/gi; s/(?:^|\b)(\w+)ing\b/$1ink/g; s/v/rand > 0.1 ? 'w' : 'v'/gie; s/([^aeiou])u\B/rand > 0.8 ? "$1oo" : "$1u"/gie; s/\b(?:a|an)\b//gi; s/\b(?:I|the|they)\b//gi; s/\bit's/is/gi; s/\bit\b//gi; s/(?:^|\b)(\w+)ew\b(?!['&;])/$1yoot/gi; s/(?:^|\b)(\w+)([^'&;\s])\b(?!['&;])/ if (length($1.$2) > 5){ my $r=rand; $1 . $2 . ( $r > .90 ? 'skoye' : $r > .85 ? 'kov' : $r > .77 ? 'ski' : $r > .65 ? 'ska' : '' ) } else { $1.$2 } /egix; s/([^y])e/$1ye/gi; #s/(^|[.!?])\s*(\w)/"$1 " . uc($2)/eg; return "$_\n"; } sub spanish { #pseudo-spanish $_ = shift; s/n([aeiou])/&ntilde;$1/g; s/\bmuch\b/mucho/ig; s/\bvery\b/muy/ig; s/\bother\b/otro/ig; s/\bwhere\b/donde/ig; s/\bwith\b/con/ig; s/\ba\b/un/ig; s/\bwell\b/bueno/gi; s/\bof\b/de/gi; s/\byes\b/si/gi; s/\bHow\b/como/gi; s/\bare\b/son/gi; if ((/\bthe\b/i) && (rand > 0.5)){ s/\bthe\b/el/; } else { s/\bthe\b/la/; }; s/\bde el\b/del/gi; s/\b(\w{4,})([^aei])s\b(?!['&])/$1$2es/gi; s/\b(\w+)([^'&a;esioyu0-9\s])\b(?!['&;])/ if (length($1.$2) > 3){ my $r=rand; $1 . $2 . ($r > .75 ? 'o' : $r > .5 ? 'a' : '') } else { $1.$2 } /egix; return $_; }

Comment on Acme::Translator
Download Code
Replies are listed 'Best First'.
Re: Acme::Translator
by epoptai (Curate) on May 28, 2001 at 04:18 UTC
    D4 M0NZ374RY G8Z is too funny, ++!

    Here's a slightly rearranged version of the first print block with a minor typo corrected in the line after end_form (ended with ; instead of ,):

    print $q->header(), $q->start_html('Acme::Translator'), $q->h1('Acme::Translator'), $q->start_form(-method=>'get'), $q->p('Enter a URL, or Text with no URL, to translate:'), $q->p("URL ", $q->textfield('url','http://','45'), $q->submit('Translate!')), $q->p($q->radio_group( 'language', [keys %languages], 'russian')), $q->p("Text<br>", $q->textarea('text','','10','60')), $q->end_form, $q->p("'k3wlt0k' and 'pig' are just hooks to the Text::B +astardize function"), $q->p("Remove the URL to translate what's in the textare +a"), $q->end_html;
    You could also make $location set itself by moving it after the new CGI and saying:
    my $location = $q->url();

    --
    Get some Perlmonks Related Scripts like framechat, reputer, and xNN.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://83644]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (16)
As of 2015-07-28 16:55 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (258 votes), past polls