File Coverage

blib/lib/POE/Filter/JSON/Incr.pm

Criterion	Covered	Total	%
statement	55	56	98.2
branch	9	12	75.0
condition			n/a
subroutine	15	15	100.0
pod	6	7	85.7
total	85	90	94.4

#!/usr/bin/perl

package POE::Filter::JSON::Incr;
use Any::Moose;

use JSON;
use POE::Filter::JSON::Incr::Error;

use namespace::clean -except => [qw(meta)];

our $VERSION = "0.03";

extends our @ISA, qw(POE::Filter);

# with qw(MooseX::Clone)

sub clone {
	my ( $self, @args ) = @_;

	die "metaclass doesn't support cloning" unless $self->meta->can("clone_object");

	$self->meta->clone_object(
		$self,
		@args,
		# clear the buffers
		buffer => [],
		json => $self->_build_json,
	);
}

has buffer => (
	#traits => [qw(NoClone)],
	isa => "ArrayRef",
	is  => "rw",
	lazy_build => 1,
);

sub _build_buffer { [] }

has json => (
	#traits => [qw(NoClone)],
	is => "rw",
	lazy_build => 1,
	handles => [qw(encode incr_parse incr_skip)],
);

has json_opts => (
	isa => "ArrayRef",
	is  => "rw",
	lazy_build => 1,
);

sub _build_json {
	my $self = shift;

	my $json = JSON->new;

	foreach my $opt ( @{ $self->json_opts } ) {
		$json->$opt;
	}

	return $json;
}

sub _build_json_opts {
	return [qw(
		relaxed
		allow_nonref
		utf8
	)];
}

has error_class => (
	isa => "ClassName",
	is  => "rw",
	default => "POE::Filter::JSON::Incr::Error",
	handles => { create_error_object => "new" },
);

has errors => (
	isa => "Bool",
	is  => "rw",
	default => 0,
);

sub get_one_start {
	my ( $self, $chunks ) = @_;
	$chunks = [ $chunks ] unless ref $chunks;
	push @{ $self->buffer }, $self->_parse($chunks);
}

sub get_one {
	my $self = shift;
	return [ splice @{ $self->buffer }, 0, 1 ]; # shift returns undef, this returns empty list
}

sub get {
	my ( $self, $chunks ) = @_;

	return [
		splice(@{ $self->buffer }),
		$self->_parse($chunks),
	];
}

sub _parse {
	my ( $self, $chunks ) = @_;

	my @ret;

	foreach my $chunk ( @$chunks ) {
		local $@;
		if ( my @out = eval { $self->incr_parse($chunk) } ) {
			push @ret, @out;
		}

		if ( $@ ) {
			$self->incr_skip;
			push @ret, $self->json_error(error => $@, chunk => $chunk);
		}
	}

	return @ret;
}

sub json_error {
	my ( $self, @args ) = @_;

	if ( $self->errors ) {
		return $self->create_error_object(@args);
	} else {
		return ();
	}
}

sub put {
	my ( $self, $data ) = @_;
	return [ map { $self->encode($_) . "\n" } @$data ];
}

sub get_pending {
	my $self = shift;

	if ( my @contents = @{ $self->buffer } ) {
		return \@contents;
	} else {
		return undef;
	}
}

__PACKAGE__

__END__