#!/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 $_;
}
[download]