Commit | Line | Data |
bf960837 |
1 | package LolCatalyst::Lite::Translator::Driver::Scramble; |
5d5f55d8 |
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; |