1 # Copyright (c) 2003 Chris Angell (chris62vw@hotmail.com). All rights reserved.
2 # This program is free software; you can redistribute it and/or
3 # modify it under the same terms as Perl itself.
6 # Mary had a little lamb and her fleece was white as snow
8 # Mray had a liltte lmab and her flecee was whtie as sonw
20 return unless &::loadPerlModule("List::Util");
21 srand(); # fork seems to not change rand. force it here
22 for my $orig_word (split /\s+/, $text)
24 # skip words that are less than four characters in length
25 $scrambled .= "$orig_word " and next if length($orig_word) < 4;
27 # get first and last characters, and middle characters
28 # optional characters are for punctuation, etc.
29 my ($first, $middle, $last) = $orig_word =~ /^['"]?(.)(.+)'?(.)[,.!?;:'"]?$/;
31 my ($new_middle, $cnt);
33 # shuffle until $new_middle is different from $middle
36 # theoretically, this loop could loop forever, so
37 # a counter is used. once $cnt > 10 then use a
38 # simple regex to scramble and call it good
42 # non-random shuffle, but good enough
43 ($new_middle = $middle) =~ s/(.)(.)/$2$1/g;
46 # shuffle the middle letters
47 $new_middle = join '', List::Util::shuffle(split //, $middle);
49 while (($cnt < 10) && ($middle eq $new_middle));
51 # add the word to the list...
52 $scrambled .= "$first$new_middle$last ";
55 # remove the single trailing space, and any other space that may have
56 # been included in the original string
57 $scrambled =~ s/\s+$//;
59 &::performStrictReply($scrambled||'Unknown Error Condition');