File Coverage

blib/lib/POE/Filter/KennySpeak.pm

Criterion	Covered	Total	%
statement	79	81	97.5
branch	19	22	86.3
condition	3	3	100.0
subroutine	11	12	91.6
pod	6	6	100.0
total	118	124	95.1

package POE::Filter::KennySpeak;
$POE::Filter::KennySpeak::VERSION = '1.02';
#ABSTRACT: Mmm PfmPpfMpp Mpfmffpmffmpmpppff fmpmfpmmmfmp fmppffmmmpppfmmpmfmmmfmpmppfmm fmpppf mmmpppmpm mpfpffppfppm PmpmppppppppffmFmmpfmmppmmmpmp

use strict;
use warnings;

use base qw(POE::Filter);

my $kenny   = _generateKenny();          # encoding table
my $dekenny = _generateDeKenny($kenny);  # decoding table

sub new {
  my $class = shift;
  my %opts = @_;
  $opts{lc $_} = delete $opts{$_} for keys %opts;
  $opts{BUFFER} = [];
  return bless \%opts, $class;
}

sub get_one_start {
  my ($self, $raw) = @_;
  push @{ $self->{BUFFER} }, $_ for @$raw;
}

sub get_one {
  my $self = shift;
  my $events = [];

  my $event = shift @{ $self->{BUFFER} };
  if ( defined $event ) {
    my $record = _translate($event,1);
    push @$events, $record if $record;
  }
  return $events;
}

sub get_pending {
  my $self = shift;
  return $self->{BUFFER};
}

sub put {
  my ($self, $events) = @_;
  my $raw_lines = [];

  foreach my $event (@$events) {
     if ( defined $event ) {
	my $record = _translate($event);
	push @$raw_lines, $record if $record;
     }
  }

  return $raw_lines;
}

sub clone {
  my $self = shift;
  my $nself = { };
  $nself->{$_} = $self->{$_} for keys %{ $self };
  $nself->{BUFFER} = [ ];
  return bless $nself, ref $self;
}

##### Generate KennySpeak encoding table

sub _generateKenny {
    my %kenny;

    # lower case characters

    my ($a, $b, $c) = (0,0,0);
    for my $char ("a".."z") {
	my $foo = $a.$b.$c;
	$foo =~ tr/012/mpf/;
	$kenny{$char} = $foo;
	$c++;
	if ($c == 3) {
	    $c=0;
	    $b++;
	    if ($b == 3) {
		$b=0;
		$a++;
	    }
	}
    }

    # upper case characters

    map { $kenny{uc $_} = ucfirst $kenny{$_} } keys %kenny;

    return \%kenny;
}



##### Generate KennySpeak decoding table

sub _generateDeKenny {
    my %dekenny;
    my $kenny = $_[0];
    foreach my $key (keys %{$kenny})
    {
	my ($a, $b, $c) = split //, $kenny->{$key};
	if (! exists $dekenny{$a}) {
	    $dekenny{$a} = {};
	}
	if (! exists $dekenny{$a}->{$b}) {
	    $dekenny{$a}->{$b} = {};
	}
	$dekenny{$a}->{$b}->{$c} = $key;
    }

    return \%dekenny;
}


##### Encode/decode a given line

sub _translate {
    my $in  = shift;
    my $dialect = shift;
    my $out = '';
    if ($dialect) {
        $out .= exists $kenny->{$1} ? $kenny->{$1} : $1 while ($in =~ s/^(.)//);
    }
    else {
        my @chars = split //, $in;
        while (@chars) {
            if ((@chars > 2) and (exists $dekenny->{$chars[0]}->{$chars[1]}->{$chars[2]})) {
                $out .= $dekenny->{$chars[0]}->{$chars[1]}->{$chars[2]};
                shift @chars;
                shift @chars;
                shift @chars;
            }
	    else {
                $out .= shift @chars;
            }
        }
    }
    return $out;
}


'Fmpmmmpmfpmp pmfmffpmpmpp Pmpmppppppppffm!';

#
# kenny.pl -- translate from and to KennySpeak
#
# $Revision: 1.7 $
#
# Licensed unter the Artistic License:
# http://www.perl.com/language/misc/Artistic.html
#
# (C) 2001,2002 by Christian Garbs , http://www.cgarbs.de
#                  Alan Eldridge
#
# KennySpeak invented by Kohan Ikin
#                        http://www.namesuppressed.com/kenny/

__END__