Repository List / perl / trunk / rnd4.pl @ HEAD

#!/usr/bin/perl -w

# 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.
#
# Dobrica Pavlinusic <dpavlin@rot13.org> 2004-06-16
#
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(<STDIN>) {
	s/(\w)(\w+)(\w)/rnd4($1,$2,$3)/eg;
	print;
}