POE::Filter::KennySpeak - Mmm PfmPpfMpp Mpfmffpmffmpmpppff fmpmfpmmmfmp fmppffmmmpppfmmpmfmmmfmpmppfmm fmpppf mmmpppmpm mpfpffppfppm PmpmppppppppffmFmmpfmmppmmmpmp

        # A Kennyspeak echo server

	use strict;
	use warnings;

	use POE;
	use POE::Component::Server::TCP;
	use POE::Filter::Stackable;
	use POE::Filter::Line;
	use POE::Filter::KennySpeak;

	POE::Component::Server::TCP->new(
	    Port => 12345,
	    ClientInputFilter => POE::Filter::Stackable->new(
		Filters => [
			POE::Filter::Line->new(),
			POE::Filter::KennySpeak->new(),
		],
	    ),
	    ClientOutputFilter => POE::Filter::Line->new(),
	    ClientInput => sub {
	      $_[HEAP]{client}->put($_[ARG0]);
	      return;
	    },
	);

	POE::Kernel->run();
	exit;

package POE::Filter::KennySpeak;

use strict;
use warnings;

use base qw(POE::Filter);
use vars qw($VERSION);

$VERSION = '1.00';

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!';
__END__

#
# 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 <mitch@cgarbs.de>, http://www.cgarbs.de
#                  Alan Eldridge <alane@geeksrus.net>
#
# KennySpeak invented by Kohan Ikin <syneryder@namesuppressed.com>
#                        http://www.namesuppressed.com/kenny/