From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sat, 7 Feb 2009 19:29:08 +0000 (+0000)
Subject: add scramble translator plugin and tests
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2Fcatbook-code.git;a=commitdiff_plain;h=5d5f55d852f103999f8f27041e22e29436aa69f2

add scramble translator plugin and tests
---

diff --git a/lib/LolCatalyst/Lite/Translator/Scramble.pm b/lib/LolCatalyst/Lite/Translator/Scramble.pm
new file mode 100644
index 0000000..3fc524a
--- /dev/null
+++ b/lib/LolCatalyst/Lite/Translator/Scramble.pm
@@ -0,0 +1,45 @@
+package LolCatalyst::Lite::Translator::Scramble;
+
+use Moose;
+
+# stolen from Catalyst::Plugin::Acme::Scramble
+
+sub shuffle {
+    for ( my $i = @_; --$i; ) {
+        my $j = int(rand($i+1));
+        @_[$i,$j] = @_[$j,$i];
+    }
+}
+
+sub _scramble_word {
+    my $word = shift || return '';
+    my @piece = split //, $word;
+    shuffle(@piece[1..$#piece-1])
+        if @piece > 2;
+    join('', @piece);
+}
+
+sub _scramble_block {
+    my $text = shift;
+
+    ${$text} =~ s{
+                  ( (?:(?<=[^[:alpha:]])|(?<=\A))
+                    (?<!&)(?-x)(?<!&#)(?x)
+                    (?:
+                       ['[:alpha:]]+ | (?<!-)-(?!-)
+                     )+
+                    (?=[^[:alpha:]]|\z)
+                   )
+                  }
+                 {_scramble_word($1)}gex;
+}
+
+use namespace::clean -except => 'meta';
+
+sub translate {
+  my ($self, $text) = @_;
+  _scramble_block(\$text);
+  return $text;
+}
+
+1;
diff --git a/t/translator/scramble.t b/t/translator/scramble.t
new file mode 100644
index 0000000..2862dfe
--- /dev/null
+++ b/t/translator/scramble.t
@@ -0,0 +1,15 @@
+use strict;
+use warnings;
+use Test::More qw(no_plan);
+use LolCatalyst::Lite::Translator;
+
+ok(
+  (my $tr = LolCatalyst::Lite::Translator->new),
+  'Constructed translator object ok'
+);
+
+my $input = 'hello world';
+my $scrambled = $tr->translate_to('Scramble', $input);
+
+like($scrambled, qr/h...o w...d/, 'text matches first/last');
+isnt($scrambled, $input, 'text altered');