File Coverage

blib/lib/AnyEvent/Sereal.pm

Criterion	Covered	Total	%
statement	21	21	100.0
branch			n/a
condition			n/a
subroutine	7	7	100.0
pod			n/a
total	28	28	100.0

use strict;
use warnings;
package AnyEvent::Sereal;
{
  $AnyEvent::Sereal::VERSION = '0.004';
}

use AnyEvent ();
use AnyEvent::Handle;

our $SERIALIZED_MAX_SIZE = 1_000_000; # bytes

{
    package # hide from pause
        AnyEvent::Handle;

    use Sereal::Encoder 0.09 ();
    use Sereal::Decoder 0.09 ();

    # push_write(sereal => $data, [$options])
    register_write_type(
        sereal => sub
        {
	    my $self = shift;
	    my $data = shift;

	    # When options are passed, we will create a new encoder instance
	    undef $self->{_sereal_encoder} if @_;

	    pack("w/a*",
		 ($self->{_sereal_encoder} ||= Sereal::Encoder::->new(@_))
		 ->encode($data));
        });

    # push_read(sereal => [$sereal_options], $cb->($hdl, $data))
    register_read_type(
        sereal => sub
        {
	    my $self = shift;
	    my $cb = shift;

	    # When options are passed, we will create a new decoder instance
	    undef $self->{_sereal_decoder} if @_;

	    $self->{_sereal_decoder} ||= Sereal::Decoder::->new(@_);

            return sub
            {
                # when we can use 5.10 we can use ".", but for 5.8 we
                # use the re-pack method
                defined(my $len = eval { no warnings 'uninitialized';
                                         unpack "w", $_[0]{rbuf} })
                    or return;

                if ($len > $AnyEvent::Sereal::SERIALIZED_MAX_SIZE)
                {
                    $_[0]->_error(Errno::E2BIG);
                    return;
                }

                my $format = length pack "w", $len;

                if ($format + $len <= length $_[0]{rbuf})
                {
                    my $data = substr($_[0]{rbuf}, $format, $len);
                    substr($_[0]{rbuf}, 0, $format + $len, '');

                    my $dec;
                    eval { $dec = $_[0]{_sereal_decoder}->decode($data); 1 }
                        or return $_[0]->_error(Errno::EBADMSG);

                    $cb->($_[0], $dec);
                }
                else
                {
                    # remove prefix
                    substr($_[0]{rbuf}, 0, $format, '');

                    # read remaining chunk
                    $_[0]->unshift_read(
                        chunk => $len, sub
                        {
                            my $dec;
                            eval { $dec = $_[0]{_sereal_decoder}->decode($_[1]);
				   1 } or return $_[0]->_error(Errno::EBADMSG);

                            $cb->($_[0], $dec);
                        });
                }

                return 1;
            };
        });
}

1;
__END__