lib/LolCatalyst/Lite/Translator/Driver/Scramble.pm

   1 package LolCatalyst::Lite::Translator::Driver::Scramble;
   2
   3 use Moose;
   4
   5 # stolen from Catalyst::Plugin::Acme::Scramble
   6
   7 sub shuffle {
   8     for ( my $i = @_; --$i; ) {
   9         my $j = int(rand($i+1));
  10         @_[$i,$j] = @_[$j,$i];
  11     }
  12 }
  13
  14 sub _scramble_word {
  15     my $word = shift || return '';
  16     my @piece = split //, $word;
  17     shuffle(@piece[1..$#piece-1])
  18         if @piece > 2;
  19     join('', @piece);
  20 }
  21
  22 sub _scramble_block {
  23     my $text = shift;
  24
  25     ${$text} =~ s{
  26                   ( (?:(?<=[^[:alpha:]])|(?<=\A))
  27                     (?<!&)(?-x)(?<!&#)(?x)
  28                     (?:
  29                        ['[:alpha:]]+ | (?<!-)-(?!-)
  30                      )+
  31                     (?=[^[:alpha:]]|\z)
  32                    )
  33                   }
  34                  {_scramble_word($1)}gex;
  35 }
  36
  37 use namespace::clean -except => 'meta';
  38
  39 sub translate {
  40   my ($self, $text) = @_;
  41   _scramble_block(\$text);
  42   return $text;
  43 }
  44
  45 1;