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;
}