Line # Revision Author
1 43 dpavlin #!/usr/bin/perl -w
2
3 # Aocdrnicg to a rsecareh at Cmbagrdie Uinervtisy, it denos't mtater waht
4 # oredr the ltteers in a wrod are, the olny iprmoatnt tihng is taht the frist
5 # and lsat ltteer be at the rghit pclae.The rset can be a total mses and you
6 # can sitll raed it wouthit porbelm. Tihs is bcuseae the huamn mnid deos not
7 # raed ervey lteter by istlef, but the wrod as a wlohe.
8 #
9 # This might not be complete truth, by I gave it a try. So can you.
10 # You will need Tie::DictFile for this to work (installable from
11 # CPAN using cpan shell for example), but other than that you are set.
12 #
13 # Dobrica Pavlinusic <dpavlin@rot13.org> 2004-06-16
14 #
15 use strict;
16 use Tie::DictFile;
17
18 # based on
19 # http://www.perlmonks.org/index.pl?node_id=227240
20
21 sub shuffleStr {
22 my $len = length $_[0];
23 my ($tmp, $n);
24 $n = $_+rand($len-$_)
25 , $tmp = substr( $_[0], $_, 1)
26 , substr( $_[0], $_, 1) = substr( $_[0], $n , 1)
27 , substr( $_[0], $n , 1) = $tmp
28 for 0 .. $len;
29 $_[0];
30 }
31
32 my %dict;
33 tie %dict, 'Tie::DictFile';
34
35 sub rnd4 {
36 my ($f,$m,$l) = @_;
37 my $word = $f.$m.$l;
38 if (exists $dict{$word}) {
39 return $f.shuffleStr($m).$l;
40 } else {
41 return $word;
42 }
43 }
44
45 while(<STDIN>) {
46 s/(\w)(\w+)(\w)/rnd4($1,$2,$3)/eg;
47 print;
48 }