File Coverage

blib/lib/AnyEvent/POE_Reference.pm

Criterion	Covered	Total	%
statement	44	48	91.6
branch	9	12	75.0
condition	4	8	50.0
subroutine	10	10	100.0
pod	0	1	0.0
total	67	79	84.8

package AnyEvent::POE_Reference;

use 5.008;
use strict;
use warnings;

use AnyEvent (); BEGIN { AnyEvent::common_sense }
use AnyEvent::Handle;

use Carp;

our $VERSION = '0.11';

sub FREEZE ()	{ 0 }
sub THAW ()	{ 1 }

my %SERIALIZERS;
my $ZLIB;

our $SERIALIZED_MAX_SIZE = 1_000_000; # bytes

sub new
{
    my $class = shift;

    @_ > 2 and croak "usage: ${\__PACKAGE__}->new([SERIALIZER[, COMPRESSION]])";

    my($serializer, $compress) = @_;

    $serializer ||= 'Storable';

    $compress = $compress ? '/z' : '';

    my $self = $SERIALIZERS{"$serializer$compress"};

    unless (defined $self)
    {
	$self = bless [], $class;
	eval
	{
	    (my $serializer_path = $serializer) =~ s,::,/,g;
	    require "$serializer_path.pm";

	    my $freeze = $serializer->can('nfreeze')
		|| $serializer->can('freeze')
		|| croak("${\__PACKAGE__} can't find n?freeze method "
			 . "in $serializer module");

	    my $thaw = $serializer->can('thaw')
		|| croak("${\__PACKAGE__} can't find thaw method "
			 . "in $serializer module");

	    if ($compress)
	    {
		eval { require Compress::Zlib; }
		or croak "${\__PACKAGE__} can't load Compress::Zlib";

		$self->[FREEZE] = sub
		{
		    Compress::Zlib::compress($freeze->($_[0]));
		};

		$self->[THAW] = sub
		{
		    $thaw->(Compress::Zlib::uncompress($_[0]));
		};
	    }
	    else
	    {
		$self->[FREEZE] = $freeze;
		$self->[THAW] = $thaw;
	    }

	    1;
	}
	or do
	{
	    croak "${\__PACKAGE__} can't load serializer $serializer\n";
	};

	$SERIALIZERS{"$serializer$compress"} = $self;
    }

    return $self;
}

{
    package # hide from pause
        AnyEvent::Handle;

    # poe_reference => $data, [$serializer[, $compress]]
    register_write_type(
	poe_reference => sub
	{
	    # (SELF, DATA)
	    # (SELF, SERIALIZER, DATA)
	    # (SELF, SERIALIZER, COMPRESS, DATA)
	    my $self = shift;
	    my $data = pop;

	    # (SERIALIZER)
	    # (SERIALIZER, COMPRESS)
	    my($serializer, $compress) = @_;

	    unless (ref $serializer)
	    {
		$serializer = AnyEvent::POE_Reference->new(
		    $serializer, $compress);
	    }

	    $data = $serializer->
		[AnyEvent::POE_Reference::FREEZE]->($data);
	    return length($data) . "\0" . $data;
	});

    # poe_reference => [$serializer[, $compress]], $cb->($hdl, $data)
    register_read_type(
	poe_reference => sub
	{
	    my($self, $cb, $serializer, $compress) = @_;

	    my $rbuf = \$self->{rbuf};

	    return sub
	    {
		if ($$rbuf =~ /^(\d+)(\D)/)
		{
		    if ($1 > $AnyEvent::POE_Reference::SERIALIZED_MAX_SIZE)
		    {
			$self->_error(Errno::E2BIG);
			return 0;
		    }

		    # \0 not found
		    if ($2 ne "\0")
		    {
			$self->_error(Errno::EBADMSG);
			return 0;
		    }

		    return 0 if length($$rbuf) < length($1) + 1 + $1;

		    my $buf = substr($$rbuf, 0, length($1) + 1 + $1, '');

		    unless (ref $serializer)
		    {
			$serializer = AnyEvent::POE_Reference->new(
				$serializer, $compress);
		    }

		    # FreezeThaw returns in list context...
		    if (my($ref) = eval {
			$serializer->[AnyEvent::POE_Reference::THAW]->(
			    substr($buf, length($1) + 1)) })
		    {
			$cb->($_[0], $ref);

			return 1;
		    }
		    else
		    {
			$self->_error(Errno::EBADMSG);
		    }
		}
		# Not a number...
		elsif ($$rbuf =~ /^\D/)
		{
		    $self->_error(Errno::EBADMSG);
		}
		# Too much numbers...
		elsif (length($$rbuf)
		       > length($AnyEvent::POE_Reference::SERIALIZED_MAX_SIZE))
		{
		    $self->_error(Errno::EBADMSG);
		}

		return 0;
	    };
	});
}

1;
__END__