File Coverage

blib/lib/Lingua/31337.pm

Criterion	Covered	Total	%
statement	6	23	26.0
branch	0	10	0.0
condition			n/a
subroutine	2	3	66.6
pod	1	1	100.0
total	9	37	24.3

package Lingua::31337;

use strict;

use vars qw[%EXPORT_TAGS @EXPORT $VERSION %CONVERSIONS $LEVEL];

%EXPORT_TAGS = ( 'all' => [ qw[ text231337 ] ] );

@EXPORT    = ( @{ $EXPORT_TAGS{'all'} } );

$VERSION = '0.02';

$LEVEL = 5;

%CONVERSIONS = (

  # handle the vowels
  1   => {
          mixcase => 0,
          chars => {
                    a => 4,
                    e => 3,
                    i => 1,
                    o => 0,
                   },
         },

  # Handle vowels and some consonants,
  # don't use punctuation in the translation,
  # shift case at random.
  5   => {
          mixcase => 1,
          chars => {
                    a => 4,
                    e => 3,
                    f => 'ph',
                    i => 1,
                    l => 1,
                    o => 0,
                    's$' => 'z',
                    t => 7,
                   },
         },

  # Handle vowels and most consonants,
  # use punctuation in the translation,
  # shift case at random,
  # convert some letters.
  7   => {
          mixcase => 1,
          chars => {
                    a => 4,
                    b => '|3',
                    d => '|)',
                    e => 3,
                    f => 'ph',
                    h => '|-|',
                    i => 1,
                    k => '|<',
                    l => 1,
                    'm' => '|\/|',
                    n => '|\|',
                    o => 0,
                    's$' => 'z',
                    t => '-|-',
                    v => '\/',
                    w => '\/\/',
                    x => '><',
                   },
         },

  # Handle vowels and most consonants,
  # use punctuation in the translation,
  # shift case at random,
  # convert some letters to others,
  # decide between several options.
  9   => {
          mixcase => 1,
          chars => {
                    a => [ 4, 'aw' ],
                    b => '|3',
                    ck => 'x',
                    'ck$' => 'x0rz',
                    d => '|)',
                    e => [ 3, 0, 'o' ],
                    'ed$' => 'z0r3d',
                    'er$' => '0r',
                    f => 'ph',
                    h => '|-|',
                    i => 1,
                    k => '|<',
                    l => 1,
                    'm' => '|\/|',
                    n => '|\|',
                    o => 0,
                    's' => 'z',
                    t => '-|-',
                    v => '\/',
                    w => '\/\/',
                    x => '><',
                   },
         },
);

sub text231337 {
  my @text     = @_;
  my @new_text = ();

  $LEVEL-- until exists $CONVERSIONS{$LEVEL};

  foreach my $line ( @text ) {
    foreach ( keys %{$CONVERSIONS{$LEVEL}->{chars}} ) {
      if ( ref $CONVERSIONS{$LEVEL}->{chars}->{$_} ) {
        $line =~ s/($_)/(0,1)[rand 2] ? @{$CONVERSIONS{$LEVEL}->{chars}{$_}}[rand $#{$CONVERSIONS{$LEVEL}->{chars}{$_}}] : $1/egi;
      } else {
        $line =~ s/($_)/(0,1)[rand 2] ? $CONVERSIONS{$LEVEL}->{chars}{$_} : $1/egi;
      }
    }
    $line =~ s/([A-Z])/(0,1)[rand 2] ? uc($1) : lc($1)/egi if $CONVERSIONS{$LEVEL}->{mixcase};
    push @new_text, $line;
  }
  return @new_text;
}


1;
__END__