From 9ded33cba71a92db9d4aa8add8ab410341cf9f9c Mon Sep 17 00:00:00 2001
From: timriker <timriker@c11ca15a-4712-0410-83d8-924469b57eb5>
Date: Thu, 9 Dec 2004 20:06:52 +0000
Subject: [PATCH] scramble

git-svn-id: https://svn.code.sf.net/p/infobot/code/trunk/blootbot@1098 c11ca15a-4712-0410-83d8-924469b57eb5
---
 files/sample/blootbot.chan |  3 +-
 src/CommandStubs.pl        |  3 ++
 src/Modules/scramble.pl    | 64 ++++++++++++++++++++++++++++++++++++++
 3 files changed, 69 insertions(+), 1 deletion(-)
 create mode 100644 src/Modules/scramble.pl

diff --git a/files/sample/blootbot.chan b/files/sample/blootbot.chan
index f658b3c..fb8e67f 100644
--- a/files/sample/blootbot.chan
+++ b/files/sample/blootbot.chan
@@ -1,4 +1,4 @@
-#v1: Id: blootbot -- blootbot -- written Wed Nov 24 23:36:09 2004 
+#v1: blootbot -- blootbot -- written Thu Dec  9 19:57:51 2004
 
 #botpark
     +RootWarn
@@ -63,6 +63,7 @@ _default
     +page
     randomFactoidInterval 60
     randomQuoteInterval 60
+    +scramble
     +seen
     seenFlushInterval 60
     seenMaxDays 90
diff --git a/src/CommandStubs.pl b/src/CommandStubs.pl
index 65109a3..22983b9 100644
--- a/src/CommandStubs.pl
+++ b/src/CommandStubs.pl
@@ -256,6 +256,9 @@ sub parseCmdHook {
 &addCmdHook("extra", 'HTTPDtype', ('CODEREF' => 'HTTPDtype::HTTPDtype',
 	'Identifier' => 'HTTPDtype', 'Cmdstats' => 'HTTPDtype',
 	'Forker' => 1) );
+&addCmdHook("extra", 'scramble', ('CODEREF' => 'scramble::scramble',
+	'Identifier' => 'scramble', 'Cmdstats' => 'scramble',
+	'Forker' => 1) );
 &addCmdHook("extra", 'Rss', ('CODEREF' => 'Rss::Rss',
 	'Identifier' => 'Rss', 'Cmdstats' => 'Rss',
 	'Forker' => 1, 'Help' => 'rss') );
diff --git a/src/Modules/scramble.pl b/src/Modules/scramble.pl
new file mode 100644
index 0000000..5bbb597
--- /dev/null
+++ b/src/Modules/scramble.pl
@@ -0,0 +1,64 @@
+# Copyright (c) 2003 Chris Angell (chris62vw@hotmail.com). All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+# Turns this:
+# Mary had a little lamb and her fleece was white as snow
+# into this:
+# Mray had a liltte lmab and her flecee was whtie as sonw
+
+use strict;
+use warnings;
+
+package scramble;
+
+use List::Util;
+
+sub scramble
+{
+  my ($text) = @_;
+  my $scrambled;
+
+  srand(); # fork seems to not change rand. force it here
+  for my $orig_word (split /\s+/, $text)
+  {
+    # skip words that are less than four characters in length
+    $scrambled .= "$orig_word " and next if length($orig_word) < 4;
+
+    # get first and last characters, and middle characters
+    # optional characters are for punctuation, etc.
+    my ($first, $middle, $last) = $orig_word =~ /^['"]?(.)(.+)'?(.)[,.!?;:'"]?$/;
+
+    my ($new_middle, $cnt);
+
+    # shuffle until $new_middle is different from $middle
+    do
+    {
+      # theoretically, this loop could loop forever, so
+      # a counter is used. once $cnt > 10 then use a
+      # simple regex to scramble and call it good
+
+      if (++$cnt > 10)
+      {
+	# non-random shuffle, but good enough
+	($new_middle = $middle) =~ s/(.)(.)/$2$1/g;
+	last;
+      }
+
+      # shuffle the middle letters
+      $new_middle = join "", List::Util::shuffle(split //, $middle);
+    }
+    while ($middle eq $new_middle);
+
+    # add the word to the list...
+    $scrambled .= "$first$new_middle$last ";
+  }
+
+  # remove the single trailing space, and any other space that may have
+  # been included in the original string
+  $scrambled =~ s/\s+$//;
+
+  &::pSReply($scrambled||"Unknown Error Condition");
+}
+
+1;
-- 
2.39.2