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 sub scramble {
  16     my ($text) = @_;
  17     my $scrambled;
  18
  19     return unless &::loadPerlModule("List::Util");
  20     srand();    # fork seems to not change rand. force it here
  21     for my $orig_word ( split /\s+/, $text ) {
  22
  23         # skip words that are less than four characters in length
  24         $scrambled .= "$orig_word " and next if length($orig_word) < 4;
  25
  26         # get first and last characters, and middle characters
  27         # optional characters are for punctuation, etc.
  28         my ( $first, $middle, $last ) =
  29           $orig_word =~ /^['"]?(.)(.+)'?(.)[,.!?;:'"]?$/;
  30
  31         my ( $new_middle, $cnt );
  32
  33         # shuffle until $new_middle is different from $middle
  34         do {
  35
  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
  39
  40             if ( ++$cnt > 10 ) {
  41
  42                 # non-random shuffle, but good enough
  43                 ( $new_middle = $middle ) =~ s/(.)(.)/$2$1/g;
  44             }
  45
  46             # shuffle the middle letters
  47             $new_middle = join '', List::Util::shuffle( split //, $middle );
  48         } while ( ( $cnt < 10 ) && ( $middle eq $new_middle ) );
  49
  50         # add the word to the list...
  51         $scrambled .= "$first$new_middle$last ";
  52     }
  53
  54     # remove the single trailing space, and any other space that may have
  55     # been included in the original string
  56     $scrambled =~ s/\s+$//;
  57
  58     &::performStrictReply( $scrambled || 'Unknown Error Condition' );
  59 }
  60
  61 1;
  62
  63 # vim:ts=4:sw=4:expandtab:tw=80