Dobrica Pavlinušić's Weblog / Blog

Aocdrnicg to a rsecareh at Cmbagrdie Uinervtisy, it denos't mtater waht oredr the ltteers in a wrod are, the olny iprmoatnt tihng is taht the frist and lsat ltteer be at the rghit pclae.The rset can be a total mses and you can sitll raed it wouthit porbelm. Tihs is bcuseae the huamn mnid deos not raed ervey lteter by istlef, but the wrod as a wlohe.

This might not be complete truth, by I gave it a try. So can you. You will need Tie::DictFile for this to work (installable from CPAN using cpan shell for example), but other than that you are set.

Download code

use strict;
use Tie::DictFile;

# based on

# http://www.perlmonks.org/index.pl?node_id=227240

sub shuffleStr {

    my $len = length $_[0];

    my ($tmp, $n);

    $n = $_+rand($len-$_)

    , $tmp = substr( $_[0], $_, 1)

    , substr( $_[0], $_, 1) = substr( $_[0], $n , 1)

    , substr( $_[0], $n , 1) = $tmp

        for 0 .. $len;

    $_[0];

}

my %dict;

tie %dict, 'Tie::DictFile';

sub rnd4 {

	my ($f,$m,$l) = @_;

	my $word = $f.$m.$l;

	if (exists $dict{$word}) {

		return $f.shuffleStr($m).$l;

	} else {

		return $word;

	}

}

while() {

	s/(\w)(\w+)(\w)/rnd4($1,$2,$3)/eg;

	print;

}