Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

Acme::Translator

by OeufMayo (Curate)
on May 28, 2001 at 01:23 UTC ( [id://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 $_; }

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
Domain Nodelet?
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?Last hourOther CB clients
Other Users?
Others learning in the Monastery: (6)
As of 2024-03-19 03:13 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found