src/Modules/scramble.pl

   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.
   4
   5 # Turns this:
   6 # Mary had a little lamb and her fleece was white as snow
   7 # into this:
   8 # Mray had a liltte lmab and her flecee was whtie as sonw
   9
  10 use strict;
  11 use warnings;
  12
  13 package scramble;
  14
  15 use List::Util;
  16
  17 sub scramble
  18 {
  19   my ($text) = @_;
  20   my $scrambled;
  21
  22   srand(); # fork seems to not change rand. force it here
  23   for my $orig_word (split /\s+/, $text)
  24   {
  25     # skip words that are less than four characters in length
  26     $scrambled .= "$orig_word " and next if length($orig_word) < 4;
  27
  28     # get first and last characters, and middle characters
  29     # optional characters are for punctuation, etc.
  30     my ($first, $middle, $last) = $orig_word =~ /^['"]?(.)(.+)'?(.)[,.!?;:'"]?$/;
  31
  32     my ($new_middle, $cnt);
  33
  34     # shuffle until $new_middle is different from $middle
  35     do
  36     {
  37       # theoretically, this loop could loop forever, so
  38       # a counter is used. once $cnt > 10 then use a
  39       # simple regex to scramble and call it good
  40
  41       if (++$cnt > 10)
  42       {
  43         # non-random shuffle, but good enough
  44         ($new_middle = $middle) =~ s/(.)(.)/$2$1/g;
  45         last;
  46       }
  47
  48       # shuffle the middle letters
  49       $new_middle = join "", List::Util::shuffle(split //, $middle);
  50     }
  51     while ($middle eq $new_middle);
  52
  53     # add the word to the list...
  54     $scrambled .= "$first$new_middle$last ";
  55   }
  56
  57   # remove the single trailing space, and any other space that may have
  58   # been included in the original string
  59   $scrambled =~ s/\s+$//;
  60
  61   &::pSReply($scrambled||"Unknown Error Condition");
  62 }
  63
  64 1;