scramble

git-svn-id: https://svn.code.sf.net/p/infobot/code/trunk/blootbot@1098 c11ca15a-4712-0410-83d8-924469b57eb5

diff --git a/files/sample/blootbot.chan b/files/sample/blootbot.chan
index f658b3cdf512779af4f540cdf1a6fd9d219fcaf1..fb8e67fb4c86a0cf6f4c787a08e4a32cb9f332f6 100644 (file)
--- 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 65109a3a7bb5bd33ef9c64fadd3828be906dacd2..22983b9f87fe3394afb91aff96d7783838d248d7 100644 (file)
--- 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 (file)
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;