#!/usr/bin/perl

use strict;
use Template;
use CGI::Lite;
use HTML::Entities;

my $table_g = {
        'a'=>{ vowels => ['iu','\'','ô','e','e','ú','ie'],      constants => ['š','p','š','š','c','x','p','č']},
        'b'=>{ vowels => ['u','iu','é','í','u','\'','i'],       constants => ['s','ť','ť','p','f','š','c','f']},
        'c'=>{ vowels => ['i','í','a','ie','io','ó','io'],      constants => ['k','ch','c','š','š','s','ch','c']},
        'd'=>{ vowels => ['ie','i','a','e','\'','e','iu'],      constants => ['p','š','t','ť','p','x','s','č']},
        'e'=>{ vowels => ['e','ó','ia','o','iu','ie','u'],      constants => ['ch','ť','š','s','s','x','t','f']},
        'f'=>{ vowels => ['a','ô','e','í','ia','o','u'],        constants => ['f','s','c','p','s','c','k','š']},
        'g'=>{ vowels => ['á','e','a','ô','i','o','u'],         constants => ['š','t','k','f','č','š','c','s']},
        'h'=>{ vowels => ['o','iu','i','a','a','ô','ú'],        constants => ['š','ch','f','ť','p','p','k','ť']},
        'i'=>{ vowels => ['ú','io','i','\'','ia','e','í'],      constants => ['s','\'','ch','č','c','k','c','s']},
        'j'=>{ vowels => ['a','u','á','a','ie','ó','ia'],       constants => ['s','f','k','p','k','t','ch','c']},
        'k'=>{ vowels => ['ia','i','á','u','io','ú','í'],       constants => ['x','t','p','š','č','š','š','c']},
        'l'=>{ vowels => ['u','ia','í','i','ie','á','u'],       constants => ['ch','s','f','x','ť','k','c','č']},
        'm'=>{ vowels => ['a','ô','o','á','o','á','o'],         constants => ['ch','š','č','t','ť','p','k','x']},
        'n'=>{ vowels => ['ú','a','í','e','ie','ia','í'],       constants => ['t','k','f','x','f','ť','f','s']},
        'o'=>{ vowels => ['á','ie','ú','u','o','i','ie'],       constants => ['p','\'','t','ch','č','f','k','ch']},
        'p'=>{ vowels => ['a','ie','i','u','e','i','ú'],        constants => ['š','t','k','x','t','f','p','k']},
        'q'=>{ vowels => ['u','é','i','e','ie','a','o'],        constants => ['f','ch','x','č','ch','š','k','p']},
        'r'=>{ vowels => ['ú','iu','ú','a','u','i','u'],        constants => ['č','s','t','ch','p','š','ť','p']},
        's'=>{ vowels => ['o','\'','o','iu','á','ô','iu'],      constants => ['t','x','t','k','š','š','ť','x']},
        't'=>{ vowels => ['i','o','a','o','ia','ia','ô'],       constants => ['f','ť','č','ť','ch','k','s','t']},
        'u'=>{ vowels => ['u','\'','í','u','ó','io','u'],       constants => ['ch','k','f','p','t','c','s','s']},
        'w'=>{ vowels => ['ie','e','ô','u','i','á','á'],        constants => ['c','s','k','š','c','p','s','č']},
        'x'=>{ vowels => ['ó','a','o','iu','ia','á','i'],       constants => ['ť','č','č','s','f','k','f','č']},
        'y'=>{ vowels => ['\'','é','a','a','ia','ú','e'],       constants => ['f','š','f','ch','ť','f','ť','p']},
        'z'=>{ vowels => ['a','o','i','ia','i','á','a'],        constants => ['ch','x','š','t','f','k','x','t']},
        '1'=>{ vowels => ['o','o','í','ie','a','ô','ie'],       constants => ['x','ť','x','ť','s','š','ť','ch']},
        '2'=>{ vowels => ['io','i','é','ô','io','a','u'],       constants => ['ť','t','s','ť','ť','č','š','c']},
        '3'=>{ vowels => ['ia','e','\'','í','io','e','ô'],      constants => ['p','x','p','k','x','f','č','k']},
        '4'=>{ vowels => ['u','u','e','ú','\'','a','a'],        constants => ['ť','p','f','ť','t','ť','p','č']},
        '5'=>{ vowels => ['a','o','í','i','o','i','é'],         constants => ['č','p','p','t','ť','č','š','c']},
        '6'=>{ vowels => ['í','e','a','ie','o','ó','o'],        constants => ['č','ch','k','f','c','f','t','ť']},
        '7'=>{ vowels => ['a','ia','ú','e','iu','i','ie'],      constants => ['s','c','k','c','č','k','c','š']},
        '8'=>{ vowels => ['a','u','á','o','í','ie','u'],        constants => ['č','ch','ch','p','p','š','s','š']},
        '9'=>{ vowels => ['u','e','e','ú','u','u','é'],         constants => ['š','p','ť','š','ch','s','c','x']},
        '0'=>{ vowels => ['ó','á','u','u','a','é','i'],         constants => ['ť','ch','f','ť','ť','s','t','x']},
};


sub translate_g($) {
   my ($msg) = @_;

   $msg =~ tr/áäÁÄčČďĎéeÉĚíÍľĺĽĹňŇóOôÔŕřŔŘšŠťŤúÚýÝžŽ/aaAAcCdDeeEEiIllLLnNoOoOrrRRsStTuUyYzZ/;

   my $out;
   while ($msg =~ /(\b?.*?\b)/sgm) {
      my $word = $1;
      if ($word ne '') {
         my $chars;
         @{$chars} = split(//,$word);
         my $translated;
         my $vowel = 1;
         my $vowels;
         my $tmp_sum = 0;
         foreach my $char (@{$chars}) {$tmp_sum += unpack("C*", $char);}
         if (length($tmp_sum) % 4 == 0) {$vowel = 0;}

         my $iter = 0;
         my $len = scalar(@{$chars});
         my $sum = 0;
         my $uses;
         foreach my $char (@{$chars}) {
            my $translate_char;
            my $uclc = 0;
            if (lc $char ne $char) {
               $uclc = 1;
            }
            $sum += unpack("C*", $char);
            if ( (scalar(@{$chars})!=1 && $vowels->{$char}!=1) && (($vowel == 1 && $sum%4!=0) || $vowel >= 1)) {
               if ($uclc == 1) {$char = lc($char);}
               if (defined($table_g->{$char})) {
                  $translate_char = $table_g->{$char}->{constants}->[ $uses->{$char}->{constants} % scalar(@{$table_g->{$char}->{constants}}) ];
               }
               if ($uclc == 1) {$translate_char = uc($translate_char);}
               ++$uses->{$char}->{constants};
               $vowel = 0;
            } else {
               if ($uclc == 1) {$char = lc($char);}
               if (defined($table_g->{$char})) {
                  $translate_char = $table_g->{$char}->{vowels}->[ $uses->{$char}->{vowels} % scalar(@{$table_g->{$char}->{vowels}}) ];
               }
               if ($iter+2>$len && $translate_char eq '\'') {
                  ++$uses->{$char}->{vowels};
                  if (defined($table_g->{$char})) {
                     $translate_char = $table_g->{$char}->{vowels}->[ $uses->{$char}->{vowels} % scalar(@{$table_g->{$char}->{vowels}}) ];
                  }
               }
               if ($uclc == 1) {$translate_char = uc($translate_char);}
               ++$uses->{$char}->{vowels};
               ++$vowel;
            }
            if ($translate_char eq '') {$translate_char = $char;}
            $translated .= $translate_char;
            ++$iter;
         }
         if ($translated eq '') {$translated = $word;}
      $out .= $translated;
      }
   }

   return $out;
}


my $cgi = CGI::Lite->new();
my $q = $cgi->parse_new_form_data();



print "Content-type: text/html\n\n";
print '<html><body>';
print '<meta http-equiv="Content-Type" content="text/html; charset=utf-8">';
print '<form method="GET" action="translate.cgi">';
print 'Text na prelozenie: <input type="text" name="translate" value="'.HTML::Entities::encode($q->{translate}).'"> <input type="submit" value="Prelozit">';
print '</form>';
print '<b>Prelozeny text:</b> '.&translate_g($q->{translate});
print '</body></html>';