File Coverage

blib/lib/AnyEvent/Serialize.pm

Criterion	Covered	Total	%
statement	37	68	54.4
branch	2	14	14.2
condition			n/a
subroutine	11	14	78.5
pod	2	2	100.0
total	52	98	53.0

package AnyEvent::Serialize;

use 5.010001;
use strict;
use warnings;
use Carp;

require Exporter;

use AnyEvent::AggressiveIdle qw(aggressive_idle stop_aggressive_idle);


our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration       use AnyEvent::Serialize ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(serialize deserialize) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw();

our $VERSION = '0.05';


our $block_size = 1024;

sub import
{
    my ($class, @arg) = @_;


    for (reverse 0 .. $#arg - 1) {
        next unless $arg[$_] eq 'block_size';
        my $bs = $arg[$_ + 1];
        croak "Usage: use AnyEvent::Serialize block_size => 512 ..."
            unless $bs > 0;
        $block_size = $bs;
        splice @arg, $_, 2;
        last;
    }

    return $class->export_to_level(1, $class,  @arg);
}


sub serialize($&) {
    require Data::StreamSerializer;
    no warnings 'redefine';
    no strict 'refs';

    *{ __PACKAGE__ . '::serialize' } = sub ($&) {
        my ($obj, $cb) = @_;
        my $sr = new Data::StreamSerializer $obj;
        $sr->block_size($block_size);

        my $str = $sr->next;

        if ($sr->is_eof()) {
            $cb->($str, $sr->recursion_detected);
            return;
        }

        aggressive_idle {
            my $pid = shift;
            my $part = $sr->next;
            $str .= $part if defined $part;
            if ($sr->is_eof) {
                stop_aggressive_idle $pid;
                $cb->($str, $sr->recursion_detected);
            }
        };
    };

    goto &serialize;
}

sub deserialize($&) {
    require Data::StreamDeserializer;
    no warnings 'redefine';
    no strict 'refs';

    *{ __PACKAGE__ . '::deserialize' } = sub ($&) {
        my ($data, $cb) = @_;
        my $dsr = new Data::StreamDeserializer
            data => $data, block_size => $block_size;

        if ($dsr->next_object) {
            $cb->($dsr->result, $dsr->error, $dsr->tail);
            return;
        }

        aggressive_idle {
            my $pid = shift;
            return unless $dsr->next;
            stop_aggressive_idle($pid);
            $cb->($dsr->result('first'), $dsr->error, $dsr->tail);
        };
    };

    goto &deserialize;
}

1;

__END__