File Coverage

blib/lib/Data/StreamDeserializer.pm

Criterion	Covered	Total	%
statement	84	95	88.4
branch	33	46	71.7
condition	3	8	37.5
subroutine	17	18	94.4
pod	11	11	100.0
total	148	178	83.1

package Data::StreamDeserializer;

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

require Exporter;
use AutoLoader;

our @ISA = qw(Exporter);
our $VERSION = '0.06';

use XSLoader;
XSLoader::load('Data::StreamDeserializer', $VERSION);

sub new
{
    my ($class, %opts) = @_;
    my $class_name = ref($class) || $class;

    my $self = $class_name->_low_level_new;
    $self->block_size($opts{block_size}) if exists $opts{block_size};
    if (exists $opts{data}) {
        $self->part($opts{data});
        $self->part;
    }
    return $self;
}


sub block_size
{
    my ($self, $value) = @_;
    return $self->{block_size} unless @_ > 1;
    croak "You can't set zero block_size" unless $value;
    return $self->{block_size} = $value;
}


sub part
{
    my ($self, @data) = @_;
    goto SET_EOF unless @data;
    goto SET_EOF unless defined $data[0];
    $self->{data} .= join '', @data;
    return;

    SET_EOF:
        $self->{data} .= ' ' unless $self->{eof}; # hack for tail digists
        $self->{eof} = 1;
        return;
}


sub next
{
    my ($self, @data) = @_;

    $self->part(@data) if @data;


    return 1 if $self->{done};
    if ($self->{seen} < -1 + length $self->{data}) {
        return 0 unless $self->_ds_look_tail;
        goto CHECK_ERROR;
    }
    goto CHECK_ERROR if $self->{eof};
    return 0;

    CHECK_ERROR:
        my $mode = $self->{mode};
        if ($mode < 0) {
            $self->_push_error($self->_error_string);
            delete $self->{data};
            return $self->{done} = 1;
        }
        if ($self->{eof}) {
            return 0 if $self->{seen} < -1 + length $self->{data};
            if (@{$self->{markers}}) {
                $self->_push_error(
                    sprintf "Unclosed brackets: '%s'",
                        join "', '", map $_->[0], @{ $self->{markers} }
                );
            }
            delete $self->{data};
            return $self->{done} = 1;
        }

        return 0;
}

sub is_done
{
    my ($self) = @_;
    return $self->{done};
}

sub next_object
{
    my ($self, @data) = @_;
    my $cnt = $self->{object_counter};

    $self->{one_object_mode} = 1;
    my $res = $self->next(@data);
    $self->{one_object_mode} = 0;
    return 1 if $res;
    return $cnt < $self->{object_counter};
}

sub skip_divider
{
    my ($self) = @_;
    $self->_skip_divider;
}

sub is_error
{
    my ($self) = @_;
    return scalar @{ $self->{error} };
}

sub error
{
    my ($self) = @_;
    return '' unless @{ $self->{error} };
    return join "\n", @{ $self->{error} };
}


sub tail
{
    my ($self) = @_;
    if ($self->{eof}) {
        return '' unless length $self->{tail};
        return substr $self->{tail}, 0, -1 + length $self->{tail};
    }
    return $self->{tail};
}


sub result
{
    my ($self, $behaviour) = @_;
    $behaviour ||= 'first';
    return $self->{queue}[0] if $behaviour eq 'first';
    return $self->{queue} if $behaviour eq 'all';
    croak "Unknown behaviour '$behaviour'";
}

sub _push_error
{
    my ($self, $error) = @_;
    return if @{$self->{error}} and $self->{error}[-1] eq $error;
    push @{ $self->{error} }, $error;
    return;
}

1;

__END__