#!/usr/bin/perl

use strict;
use warnings;

while(<>) {
	s/\b(\w+)\b/&wortspiel($1)/ge;
	print;
}

sub wortspiel {
  if ($_[0] =~ m/\b(\w)(\w+)(.)\b/) {
    my @letters = split(//, $2);
    shuffle (\@letters);
    return $1.join ('', @letters).$3;
  }
  else {
    return $_[0];
    }
}

sub shuffle {

  # vgl. O'Reilly, Perl-Kochbuch dt., 1. Auflage, 4.17, fisher-yates-shuffle

  my $array = shift;
  my $i;

  for ($i = @$array; --$i; ) {
    my $j = int rand ( $i+1 );
    next if $i == $j;
    @$array[$i, $j] = @$array[$j, $i];
    }
}

use List::Util qw//;
while (<>) {
        s               {\b(\w)(\w*)(\w)\b}
                        {$1 . join ("", List::Util::shuffle (split //, $2)) . $3}eg;
        print;
}

use List::Util qw//;
use constant DEBUG => 1;
my %hash = ();
while (<>) {
        s               {\b(\w)(\w+)(\w)\b}
                        {heuristic_replace (eval join (", " => map {"\$$_"} 1 .. 3))}eg;
        print;
        if (DEBUG) { push @{ $hash{length $_} }, $_ foreach split; }
}

if (DEBUG) {
        print "\nWORD LIST\n";
        foreach my $l (sort grep {$_ > 3} keys %hash) {
                print "length $l:\n";
                print "\t$_\n" foreach @{ $hash{$l} };
                print "\n";
        }
}

sub heuristic_replace {
        my ($first, $word, $last) = @_;

        print "\nDEBUG: [$first] [$word] [$last]\n" if DEBUG;

        my $word_len = length ($word);
        my $first_is_consonant = (grep {$first eq $_} split //, "aeiou")>0?1:0;
        my $last_is_consonant = (grep {$last eq $_} split //, "aeiou")>0?1:0;

        print "first_is_consonant: $first_is_consonant\n" if DEBUG;
        print "last_is_consonant: $last_is_consonant\n" if DEBUG;

        # words of length = 3 are left untouched
        return join "", @_ if $word_len == 1;

        # words of length = 4 have their middle two chars swapped
        $word_len == 2 and return $first . reverse ($word) . $last;

        # do a generic shuffle at the moment
        return $first . join ("", List::Util::shuffle (split //, $word)) . $last;
}