File Coverage

lib/Parse/AFP/Base.pm

Criterion	Covered	Total	%
statement	63	75	84.0
branch	20	28	71.4
condition	0	2	0.0
subroutine	12	15	80.0
pod	0	9	0.0
total	95	129	73.6

package Parse::AFP::Base;

use strict;
use Parse::Binary;
use base 'Parse::Binary';
use constant BASE_CLASS => 'Parse::AFP';
use constant DEFAULT_ARGS => ( Length => 0 );

sub padding {
    my ($self, $field) = @_;
    my $padding = $self->PADDING;
    return $padding if defined($padding);
    return "\xFF" x $self->member_length_bytes;
}

sub member_length_bytes {
    my ($self) = @_;
    my ($field) = $self->member_fields or return 0;
    $self->field_format($field) =~ m{(\S+)/} or return 0;
    return length(pack($1, 0));
}

sub refresh_length {
    my ($self) = @_;
    if ($self->has_field('Length')) {
	my $length = length($self->dump);
	foreach my $field ($self->fields) {
	    last if $field eq 'Length';
	    $length -= $self->field_length($field);
	}
	$self->SetLength($length);
    }
}

sub refresh_parent {
    my ($self) = @_;
    $self->refresh_length;
    $self->SUPER::refresh_parent;
}

sub load_size {
    my ($self, $data) = @_;
    $self->SUPER::load_size($data);
    if ($self->has_field('Length')) {
	$self->SetLength( $self->Length + $self->field_length('Length') );
    }
}

sub dump {
    my ($self) = @_;

    local $SIG{__WARN__} = sub {};
    return $self->SUPER::dump unless $self->has_members;

    my $out = '';
    foreach my $field ($self->fields) {
	my $packer = $self->field_packer($field) or die "No packer for $field\n";

	if ($self->member_class($field)) {
	    my $format = $packer->{Format}[0];
	    my $prefix = ($format =~ m{\((.*?)/}) ? $1 : '';
	    my $length = $self->member_length_bytes;

	    foreach my $member (@{$self->field($field)}) {
		my $rv = $packer->format({ $field => $member });
		if ($prefix) {
		    my @leading = unpack($prefix, $rv);
		    $leading[-1] += $length;
		    my $leading = pack($prefix, @leading);
		    substr($rv, 0, length($leading), $leading);
		}
		$out .= $rv;
	    }
	}
	else {
	    $out .= $packer->format($self->struct);
	}
    }

    $self->set_size(length($out));
    return $out;
}

sub set_field_arrayref {
    my ($self, $field, $data) = @_;
    @{$self->struct->{$field}||=[]} = @{$data||[]};
}

sub validate_memberdata {
    my ($self, $field) = @_;
    $field = $self->field($field) or return;
    @$field = grep {
	ref($_) eq 'CODE' or $self->valid_memberdata($field, $_)
    } @$field;
}

sub spawn_obj {
    my $self = shift;
    my $obj = $self->spawn(CC => '5a', @_);
    @{$obj}{qw( lazy output )} = @{$self}{qw( lazy output )};
    $obj->refresh;
    return $obj;
}

1;