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.5