File Coverage

blib/lib/Data/ParseBinary/Constructs.pm

Criterion	Covered	Total	%
statement	427	508	84.0
branch	74	124	59.6
condition	32	83	38.5
subroutine	71	88	80.6
pod			n/a
total	604	803	75.2

package Data::ParseBinary::RoughUnion;
use strict;
use warnings;
our @ISA = qw{Data::ParseBinary::BaseConstruct};

sub create {
    my ($class, $name, @subcons) = @_;
    my $self = $class->SUPER::create($name);
    $self->{subcons} = \@subcons;
    return $self;
}

sub _parse {
    my ($self, $parser, $stream) = @_;
    my $hash = {};
    $parser->push_ctx($hash);
    my $w_stream = Data::ParseBinary::Stream::StringBufferReader->new($stream);
    $parser->push_stream($w_stream);
    my $pos = $w_stream->tell();
    foreach my $sub (@{ $self->{subcons} }) {
        my $name = $sub->_get_name();
        my $value = $parser->_parse($sub);
        $w_stream->seek($pos);
        next unless defined $name;
        $hash->{$name} = $value;
    }
    $w_stream->ReadBytes($self->{size});
    $parser->pop_ctx();
    return $hash;
}

sub _union_build {
    my ($self, $parser, $string_stream, $data) = @_;
    my $field_found = 0;
    my $pos = $string_stream->tell();
    foreach my $sub (@{ $self->{subcons} }) {
        my $name = $sub->_get_name();
        next unless exists $data->{$name} and defined $data->{$name};
        $parser->_build($sub, $data->{$name});
        $string_stream->seek($pos);
        $field_found = 1;
    }
    return $field_found;
}

sub _build {
    my ($self, $parser, $stream, $data) = @_;
    my $s_stream = Data::ParseBinary::Stream::StringWriter->new();
    $parser->push_stream($s_stream);
    my $field_found = $self->_union_build($parser, $s_stream, $data);
    die "Union build error: not found any data" unless $field_found;
    $parser->pop_stream();
    $stream->WriteBytes($s_stream->Flush());
}

package Data::ParseBinary::Union;
our @ISA = qw{Data::ParseBinary::RoughUnion};

sub create {
    my ($class, $name, @subcons) = @_;
    my $self = $class->SUPER::create($name, @subcons);
    my $size = $subcons[0]->_size_of();
    foreach my $sub (@subcons) {
        my $temp_size = $sub->_size_of();
        $size = $temp_size if $temp_size > $size;
    }
    $self->{size} = $size;
    return $self;
}

sub _build {
    my ($self, $parser, $stream, $data) = @_;
    my $s_stream = Data::ParseBinary::Stream::StringWriter->new();
    $parser->push_stream($s_stream);
    my $field_found = $self->_union_build($parser, $s_stream, $data);
    die "Union build error: not found any data" unless $field_found;
    $parser->pop_stream();
    my $string = $s_stream->Flush();
    if ($self->{size} > length($string)) {
        $string .= "\0" x ( $self->{size} - length($string) );
    }
    $stream->WriteBytes($string);
}

sub _size_of {
    my ($self, $context) = @_;
    return $self->{size};
}

package Data::ParseBinary::Select;
our @ISA = qw{Data::ParseBinary::BaseConstruct};

sub create {
    my ($class, @subconstructs) = @_;
    die "Empty Struct is illigal" unless @subconstructs;
    my $self = $class->SUPER::create(undef);
    $self->{subs} = \@subconstructs;
    return $self;
}

sub _parse {
    my ($self, $parser, $stream) = @_;
    my $orig_pos = $stream->tell();
    my $upper_hash = $parser->ctx();
    foreach my $sub (@{ $self->{subs} }) {
        $stream->seek($orig_pos);
        my $hash = {};
        $parser->push_ctx($hash);
        $parser->eval_enter();
        my $name = $sub->_get_name();
        my $value;
        eval {
            $value = $parser->_parse($sub);
        };
        $parser->eval_leave();
        $parser->pop_ctx();
        next if $@;
        $hash->{$name} = $value if defined $name;
        while (my ($key, $val) = each %$hash) {
            $upper_hash->{$key} = $val;
        }
        return;
    }
    die "Problem with Select: no matching option";
}


sub _build {
    my ($self, $parser, $stream, $data) = @_;
    my $upper_hash = $parser->ctx();
    foreach my $sub (@{ $self->{subs} }) {
        my $hash = { %$upper_hash };
        my $inter_stream = Data::ParseBinary::Stream::StringWriter->new();
        $parser->push_ctx($hash);
        $parser->push_stream($inter_stream);
        $parser->eval_enter();
        my $name = $sub->_get_name();
        eval {
            $parser->_build($sub, defined $name? $hash->{$name} : undef);
        };
        $parser->eval_leave();
        $parser->pop_stream();
        $parser->pop_ctx();
        next if $@;
        %$upper_hash = %$hash;
        $stream->WriteBytes($inter_stream->Flush());
        return;
    }
    die "Problem with Select: no matching option";
}

package Data::ParseBinary::Restream;
our @ISA = qw{Data::ParseBinary::WrappingConstruct};

sub create {
    my ($class, $subcon, $stream_name) = @_;
    my $self = $class->SUPER::create($subcon);
    $self->{stream_name} = $stream_name;
    return $self;
}

sub _parse {
    my ($self, $parser, $stream) = @_;
    my $sub_stream = Data::ParseBinary::Stream::Reader::CreateStreamReader($self->{stream_name} => $stream);
    $parser->push_stream($sub_stream);
    return $parser->_parse($self->{subcon});
}

sub _build {
    my ($self, $parser, $stream, $data) = @_;
    my $sub_stream = Data::ParseBinary::Stream::Writer::CreateStreamWriter($self->{stream_name} => Wrap => $stream);
    $parser->push_stream($sub_stream);
    $parser->_build($self->{subcon}, $data);
}

package Data::ParseBinary::ConditionalRestream;
our @ISA = qw{Data::ParseBinary::Restream};

sub create {
    my ($class, $subcon, $stream_name, $condition) = @_;
    my $self = $class->SUPER::create($subcon, $stream_name);
    $self->{condition} = $condition;
    return $self;
}

sub _parse {
    my ($self, $parser, $stream) = @_;
    if ($parser->runCodeRef($self->{condition})) {
        return $self->SUPER::_parse($parser, $stream);
    } else {
        return $parser->_parse($self->{subcon});
    }
}

sub _build {
    my ($self, $parser, $stream, $data) = @_;
    if ($parser->runCodeRef($self->{condition})) {
        $self->SUPER::_build($parser, $stream, $data);
    } else {
        $parser->_build($self->{subcon}, $data);
    }
}

package Data::ParseBinary::TunnelAdapter;
our @ISA = qw{Data::ParseBinary::WrappingConstruct};

sub create {
    my ($class, $subcon, $inner_subcon) = @_;
    my $self = $class->SUPER::create($subcon);
    $self->{inner_subcon} = $inner_subcon;
    return $self;
}

sub _parse {
    my ($self, $parser, $stream) = @_;
    my $inter = $parser->_parse($self->{subcon});
    my $inter_stream = Data::ParseBinary::StringStreamReader->new($inter);
    return $parser->_parse($self->{inner_subcon});
}

sub _build {
    my ($self, $parser, $stream, $data) = @_;
    my $inter_stream = Data::ParseBinary::Stream::StringWriter->new();
    $parser->push_stream($inter_stream);
    $parser->_build($self->{inner_subcon}, $data);
    $parser->pop_stream();
    $parser->_build($self->{subcon}, $inter_stream->Flush());
}

package Data::ParseBinary::Peek;
our @ISA = qw{Data::ParseBinary::WrappingConstruct};

sub create {
    my ($class, $subcon, $distance) = @_;
    my $self = $class->SUPER::create($subcon);
    $self->{distance} = $distance || 0;
    return $self;
}

sub _parse {
    my ($self, $parser, $stream) = @_;
    my $pos = $stream->tell();
    my $distance = $parser->runCodeRef($self->{distance});
    $stream->seek($pos + $distance);
    my $res = $parser->_parse($self->{subcon});
    $stream->seek($pos);
    return $res;
}

sub _build {
    my ($self, $parser, $stream, $data) = @_;
    # does nothing
}

sub _size_of {
    my ($self, $context) = @_;
    # the construct size is 0
    return 0;
}

package Data::ParseBinary::Value;
our @ISA = qw{Data::ParseBinary::BaseConstruct};

sub create {
    my ($class, $name, $func) = @_;
    my $self = $class->SUPER::create($name);
    $self->{func} = $func;
    return $self;
}

sub _parse {
    my ($self, $parser, $stream) = @_;
    return $parser->runCodeRef($self->{func});
}

sub _build {
    my ($self, $parser, $stream, $data) = @_;
    $parser->ctx->{$self->_get_name()} = $parser->runCodeRef($self->{func});
}

sub _size_of {
    my ($self, $context) = @_;
    # the construct size is 0
    return 0;
}

package Data::ParseBinary::LazyBound;
our @ISA = qw{Data::ParseBinary::BaseConstruct};

sub create {
    my ($class, $name, $boundfunc) = @_;
    my $self = $class->SUPER::create($name);
    $self->{bound} = undef;
    $self->{boundfunc} = $boundfunc;
    return $self;
}

sub _parse {
    my ($self, $parser, $stream) = @_;
    return $parser->_parse($parser->runCodeRef($self->{boundfunc}));
}

sub _build {
    my ($self, $parser, $stream, $data) = @_;
    return $parser->_build($parser->runCodeRef($self->{boundfunc}), $data);
}

package Data::ParseBinary::Terminator;
our @ISA = qw{Data::ParseBinary::BaseConstruct};

sub _parse {
    my ($self, $parser, $stream) = @_;
    eval { $stream->ReadBytes(1) };
    if (not $@) {
        die "Terminator expected end of stream";
    }
    return;
}

sub _build {
    my ($self, $parser, $stream, $data) = @_;
    return;
}

sub _size_of {
    my ($self, $context) = @_;
    # the construct size is 0
    return 0;
}

package Data::ParseBinary::NullConstruct;
our @ISA = qw{Data::ParseBinary::BaseConstruct};

sub _parse {
    my ($self, $parser, $stream) = @_;
    return;
}

sub _build {
    my ($self, $parser, $stream, $data) = @_;
    return;
}

sub _size_of {
    my ($self, $context) = @_;
    # the construct size is 0
    return 0;
}

package Data::ParseBinary::Pointer;
our @ISA = qw{Data::ParseBinary::BaseConstruct};

sub create {
    my ($class, $posfunc, $subcon) = @_;
    my $self = $class->SUPER::create($subcon->_get_name());
    $self->{subcon} = $subcon;
    $self->{posfunc} = $posfunc;
    return $self;
}

sub _parse {
    my ($self, $parser, $stream) = @_;
    my $newpos = $parser->runCodeRef($self->{posfunc});
    my $origpos = $stream->tell();
    $stream->seek($newpos);
    my $value = $parser->_parse($self->{subcon});
    $stream->seek($origpos);
    return $value;
}

sub _build {
    my ($self, $parser, $stream, $data) = @_;
    my $newpos = $parser->runCodeRef($self->{posfunc});
    my $origpos = $stream->tell();
    $stream->seek($newpos);
    $parser->_build($self->{subcon}, $data);
    $stream->seek($origpos);
}

sub _size_of {
    my ($self, $context) = @_;
    # the construct size is 0
    return 0;
}

package Data::ParseBinary::Switch;
our @ISA = qw{Data::ParseBinary::BaseConstruct};

sub create {
    my ($class, $name, $keyfunc, $cases, %params) = @_;
    die "Switch expects code ref as keyfunc"
        unless $keyfunc and ref($keyfunc) and UNIVERSAL::isa($keyfunc, "CODE");
    die "Switch expects hash-ref as a list of cases"
        unless $cases and ref($cases) and UNIVERSAL::isa($cases, "HASH");
    my $self = $class->SUPER::create($name);
    $self->{keyfunc} = $keyfunc;
    $self->{cases} = $cases;
    $self->{default} = $params{default};
    $self->{default} = Data::ParseBinary::NullConstruct->create() if $self->{default} and $self->{default} == $Data::ParseBinary::BaseConstruct::DefaultPass;
    return $self;
}

sub _getCont {
    my ($self, $parser) = @_;
    my $key = $parser->runCodeRef($self->{keyfunc});
    if (exists $self->{cases}->{$key}) {
        return $self->{cases}->{$key};
    }
    if (defined $self->{default}) {
        return $self->{default};
    }
    die "Error at Switch: got un-declared value, and no default was defined";
}

sub _parse {
    my ($self, $parser, $stream) = @_;
    my $value = $self->_getCont($parser);
    return unless defined $value;
    return $parser->_parse($value);
}

sub _build {
    my ($self, $parser, $stream, $data) = @_;
    my $value = $self->_getCont($parser);
    return unless defined $value;
    return $parser->_build($value, $data);
}

sub _size_of {
    my ($self, $context) = @_;
    my $size = -1;
    foreach my $subcon (values %{ $self->{cases} }) {
        my $sub_size = $subcon->_size_of($context);
        if ($size == -1) {
            $size = $sub_size;
        } else {
            die "This Switch have dynamic size" unless $size == $sub_size;
        }
    }
    if ($self->{default}) {
        my $sub_size = $self->{default}->_size_of($context);
        die "This Switch have dynamic size" unless $size == $sub_size;
    }
    return $size;
}

package Data::ParseBinary::StaticField;
our @ISA = qw{Data::ParseBinary::BaseConstruct};

sub create {
    my ($class, $name, $len) = @_;
    my $self = $class->SUPER::create($name);
    $self->{len} = $len;
    return $self;
}

sub _parse {
    my ($self, $parser, $stream) = @_;
    my $data = $stream->ReadBytes($self->{len});
    return $data;
}

sub _build {
    my ($self, $parser, $stream, $data) = @_;
    die "Invalid Value" unless defined $data and not ref $data;
    $stream->WriteBytes($data);
}

sub _size_of {
    my ($self, $context) = @_;
    return $self->{len};
}

package Data::ParseBinary::MetaField;
our @ISA = qw{Data::ParseBinary::BaseConstruct};

sub create {
    my ($class, $name, $coderef) = @_;
    die "MetaField $name: must have a coderef" unless ref($coderef) and UNIVERSAL::isa($coderef, "CODE");
    my $self = $class->SUPER::create($name);
    $self->{code} = $coderef;
    return $self;
}

sub _parse {
    my ($self, $parser, $stream) = @_;
    my $len = $parser->runCodeRef($self->{code});
    my $data = $stream->ReadBytes($len);
    return $data;
}

sub _build {
    my ($self, $parser, $stream, $data) = @_;
    die "Invalid Value" unless defined $data and not ref $data;
    $stream->WriteBytes($data);
}

package Data::ParseBinary::BitField;
our @ISA = qw{Data::ParseBinary::BaseConstruct};

sub create {
    my ($class, $name, $length) = @_;
    my $self = $class->SUPER::create($name);
    $self->{length} = $length;
    return $self;
}

sub _parse {
    my ($self, $parser, $stream) = @_;
    my $data = $stream->ReadBits($self->{length});
    my $pad_len = 32 - $self->{length};
    my $parsed = unpack "N", pack "B32", ('0' x $pad_len) . $data;
    return $parsed;
}

sub _build {
    my ($self, $parser, $stream, $data) = @_;
    my $binaryString = unpack("B32", pack "N", $data);
    my $string = substr($binaryString, -$self->{length}, $self->{length});
    $stream->WriteBits($string);
}

package Data::ParseBinary::ReversedBitField;
our @ISA = qw{Data::ParseBinary::BaseConstruct};

sub create {
    my ($class, $name, $length) = @_;
    my $self = $class->SUPER::create($name);
    $self->{length} = $length;
    return $self;
}

sub _parse {
    my ($self, $parser, $stream) = @_;
    my $data = $stream->ReadBits($self->{length});
    $data = join '', reverse split '', $data;
    my $pad_len = 32 - $self->{length};
    my $parsed = unpack "N", pack "B32", ('0' x $pad_len) . $data;
    return $parsed;
}

sub _build {
    my ($self, $parser, $stream, $data) = @_;
    my $binaryString = unpack("B32", pack "N", $data);
    my $string = substr($binaryString, -$self->{length}, $self->{length});
    $string = join '', reverse split '', $string;
    $stream->WriteBits($string);
}

package Data::ParseBinary::Padding;
our @ISA = qw{Data::ParseBinary::BaseConstruct};

sub create {
    my ($class, $count) = @_;
    my $self = $class->SUPER::create(undef);
    $self->{count_code} = $count;
    return $self;
}

sub _parse {
    my ($self, $parser, $stream) = @_;
    if ($stream->isBitStream()) {
        $stream->ReadBits($parser->runCodeRef($self->{count_code}));
    } else {
        $stream->ReadBytes($parser->runCodeRef($self->{count_code}));
    }
}

sub _build {
    my ($self, $parser, $stream, $data) = @_;
    if ($stream->isBitStream()) {
        $stream->WriteBits("0" x $parser->runCodeRef($self->{count_code}));
    } else {
        $stream->WriteBytes("\0" x $parser->runCodeRef($self->{count_code}));
    }
}

package Data::ParseBinary::RepeatUntil;
our @ISA = qw{Data::ParseBinary::BaseConstruct};

sub create {
    my ($class, $coderef, $sub) = @_;
    die "Empty MetaArray is illigal" unless $sub and $coderef;
    die "MetaArray must have a sub-construct" unless ref $sub and UNIVERSAL::isa($sub, "Data::ParseBinary::BaseConstruct");
    die "MetaArray must have a length code ref" unless ref $coderef and UNIVERSAL::isa($coderef, "CODE");
    my $name =$sub->_get_name();
    my $self = $class->SUPER::create($name);
    $self->{sub} = $sub;
    $self->{len_code} = $coderef;
    return $self;
}

sub _shouldStop {
    my ($self, $parser, $value) = @_;
    $parser->set_obj($value);
    my $ret = $parser->runCodeRef($self->{len_code});
    $parser->set_obj(undef);
    return $ret;
}

sub _parse {
    my ($self, $parser, $stream) = @_;
    my $list = [];
    $parser->push_ctx($list);
    while (1) {
        my $value = $parser->_parse($self->{sub});
        push @$list, $value;
        last if $self->_shouldStop($parser, $value);
    }
    $parser->pop_ctx();
    return $list;
}

sub _build {
    my ($self, $parser, $stream, $data) = @_;
    die "Invalid Sequence Value" unless defined $data and ref $data and UNIVERSAL::isa($data, "ARRAY");

    $parser->push_ctx($data);
    for my $item (@$data) {
        $parser->_build($self->{sub}, $item);
        last if $self->_shouldStop($parser, $item);
    }
    $parser->pop_ctx();
}

package Data::ParseBinary::MetaArray;
our @ISA = qw{Data::ParseBinary::BaseConstruct};

sub create {
    my ($class, $coderef, $sub) = @_;
    die "Empty MetaArray is illigal" unless $sub and $coderef;
    die "MetaArray must have a sub-construct" unless ref $sub and UNIVERSAL::isa($sub, "Data::ParseBinary::BaseConstruct");
    die "MetaArray must have a length code ref" unless ref $coderef and UNIVERSAL::isa($coderef, "CODE");
    my $name =$sub->_get_name();
    my $self = $class->SUPER::create($name);
    $self->{sub} = $sub;
    $self->{len_code} = $coderef;
    return $self;
}

sub _parse {
    my ($self, $parser, $stream) = @_;
    my $len = $parser->runCodeRef($self->{len_code});
    my $list = [];
    $parser->push_ctx($list);
    for my $ix (1..$len) {
        my $value = $parser->_parse($self->{sub});
        push @$list, $value;
    }
    $parser->pop_ctx();
    return $list;
}

sub _build {
    my ($self, $parser, $stream, $data) = @_;
    die "Invalid Sequence Value" unless defined $data and ref $data and UNIVERSAL::isa($data, "ARRAY");
    my $len = $parser->runCodeRef($self->{len_code});

    die "Invalid Sequence Length (length param is $len, actual input is ".scalar(@$data).")" if @$data != $len;
    $parser->push_ctx($data);
    for my $item (@$data) {
        $parser->_build($self->{sub}, $item);
    }
    $parser->pop_ctx();
}

package Data::ParseBinary::Range;
our @ISA = qw{Data::ParseBinary::BaseConstruct};

sub create {
    my ($class, $min, $max, $sub) = @_;
    die "Empty Struct is illigal" unless $sub;
    die "Repeater must have a sub-construct" unless ref $sub and UNIVERSAL::isa($sub, "Data::ParseBinary::BaseConstruct");
    my $name =$sub->_get_name();
    my $self = $class->SUPER::create($name);
    $self->{sub} = $sub;
    $self->{max} = $max;
    $self->{min} = $min;
    return $self;
}

sub _parse {
    my ($self, $parser, $stream) = @_;
    my $list = [];
    $parser->push_ctx($list);
    my $max = $self->{max};
    if (defined $max) {
        for my $ix (1..$max) {
            my $value;
            eval {
                $value = $parser->_parse($self->{sub});
            };
            if ($@) {
                die $@ if $ix <= $self->{min};
                last;
            }
            push @$list, $value;
        }
    } else {
        my $ix = 0;
        while (1) {
            $ix++;
            my $value;
            eval {
                $value = $parser->_parse($self->{sub});
            };
            if ($@) {
                die $@ if $ix <= $self->{min};
                last;
            }
            push @$list, $value;
        }
    }
    $parser->pop_ctx();
    return $list;
}

sub _build {
    my ($self, $parser, $stream, $data) = @_;
    die "Invalid Sequence Value" unless defined $data and ref $data and UNIVERSAL::isa($data, "ARRAY");
    die "Invalid Sequence Length (min)" if @$data < $self->{min};
    die "Invalid Sequence Length (max)" if defined $self->{max} and @$data > $self->{max};
    $parser->push_ctx($data);
    for my $item (@$data) {
        $parser->_build($self->{sub}, $item);
    }
    $parser->pop_ctx();
}

package Data::ParseBinary::Sequence;
our @ISA = qw{Data::ParseBinary::BaseConstruct};

sub create {
    my ($class, $name, @subconstructs) = @_;
    die "Empty Struct is illigal" unless @subconstructs;
    my $self = $class->SUPER::create($name);
    $self->{subs} = \@subconstructs;
    return $self;
}

sub _parse {
    my ($self, $parser, $stream) = @_;
    my $list = [];
    $parser->push_ctx($list);
    foreach my $sub (@{ $self->{subs} }) {
        my $name = $sub->_get_name();
        my $value = $parser->_parse($sub);
        next unless defined $name;
        push @$list, $value;
    }
    $parser->pop_ctx();
    return $list;
}


sub _build {
    my ($self, $parser, $stream, $data) = @_;
    my $subs_count = @{ $self->{subs} };
    die "Invalid Sequence Value" unless defined $data and ref $data and UNIVERSAL::isa($data, "ARRAY");
    die "Invalid Sequence Length" if @$data > $subs_count;
    $parser->push_ctx($data);
    for my $ix (0..$#$data) {
        my $sub = $self->{subs}->[$ix];
        my $name = $sub->_get_name();
        if (defined $name) {
            die "Invalid Sequence Length" if $ix >= $subs_count;
            $parser->_build($sub, $data->[$ix]);
        } else {
            $parser->_build($sub, undef);
            redo;
        }
    }
    $parser->pop_ctx();
}

sub _size_of {
    my ($self, $context) = @_;
    my $size = 0;
    foreach my $sub (@{ $self->{subs} }) {
        $size += $sub->_size_of($context);
    }
    return $size;
}

package Data::ParseBinary::Struct;
our @ISA = qw{Data::ParseBinary::BaseConstruct};

sub create {
    my ($class, $name, @subconstructs) = @_;
    die "Empty Struct is illigal" unless @subconstructs;
    my $self = $class->SUPER::create($name);
    $self->{subs} = \@subconstructs;
    return $self;
}


sub _parse {
    my ($self, $parser, $stream) = @_;
    my $hash = {};
    $parser->push_ctx($hash);
    foreach my $sub (@{ $self->{subs} }) {
        my $name = $sub->_get_name();
        my $value = $parser->_parse($sub);
        next unless defined $name;
        $hash->{$name} = $value;
    }
    $parser->pop_ctx();
    return $hash;
}

sub _build {
    my ($self, $parser, $stream, $data) = @_;
    die "Invalid Struct Value" unless defined $data and ref $data and UNIVERSAL::isa($data, "HASH");
    $parser->push_ctx($data);
    foreach my $sub (@{ $self->{subs} }) {
        my $name = $sub->_get_name();
        $parser->_build($sub, defined $name? $data->{$name} : undef);
    }
    $parser->pop_ctx();
}

sub _size_of {
    my ($self, $context) = @_;
    my $size = 0;
    foreach my $sub (@{ $self->{subs} }) {
        $size += $sub->_size_of($context);
    }
    return $size;
}

package Data::ParseBinary::Primitive;
our @ISA = qw{Data::ParseBinary::BaseConstruct};

sub create {
    my ($class, $name, $sizeof, $pack_param) = @_;
    my $self = $class->SUPER::create($name);
    $self->{sizeof} = $sizeof;
    $self->{pack_param} = $pack_param;
    return $self;
}

sub _parse {
    my ($self, $parser, $stream) = @_;
    my $data = $stream->ReadBytes($self->{sizeof});
    my $number = unpack $self->{pack_param}, $data;
    return $number;
}

sub _build {
    my ($self, $parser, $stream, $data) = @_;
    die "Invalid Primitive Value" unless defined $data;
    # FIXME and not ref $data;
    my $string = pack $self->{pack_param}, $data;
    $stream->WriteBytes($string);
}

sub _size_of {
    my ($self, $context) = @_;
    return $self->{sizeof};
}

package Data::ParseBinary::ReveresedPrimitive;
our @ISA = qw{Data::ParseBinary::Primitive};

sub _parse {
    my ($self, $parser, $stream) = @_;
    my $data = $stream->ReadBytes($self->{sizeof});
    my $r_data = join '', reverse split '', $data;
    my $number = unpack $self->{pack_param}, $r_data;
    return $number;
}

sub _build {
    my ($self, $parser, $stream, $data) = @_;
    my $string = pack $self->{pack_param}, $data;
    my $r_string = join '', reverse split '', $string;
    $stream->WriteBytes($r_string);
}

sub _size_of {
    my ($self, $context) = @_;
    return $self->{sizeof};
}

1;