Parse::Binary::Nested: simple non-OO unpackf

Make the unpackf method callable without an object, taking a template
array instead.  This turns it into a simple superset of CORE::unpack()
for most usage.  The object-oriented syntax is still supported for
reusable parsing (saves reparsing the template on each call, so should
also be slightly faster).

diff --git a/Parse/Binary/Nested.pm b/Parse/Binary/Nested.pm
index 371a65b47dbf76ff9d9893a560c5e8a1e8f1fdf9..75c22fa897eacaa3335cccec230722f6db603d02 100644 (file)
--- a/Parse/Binary/Nested.pm
+++ b/Parse/Binary/Nested.pm
@@ -5,14 +5,18 @@ use strict;
 use warnings;
 
 use Carp;
 use warnings;
 
 use Carp;

+use Exporter qw(import);

 
 

-our $VERSION = '1.02';
+our $VERSION = '1.10';
+our @EXPORT_OK = qw(unpackf);

 
 sub new {
        my ($class, $format) = @_;
 
 sub new {
        my ($class, $format) = @_;

+       ref $format
+               or $format = [0 => $format];

        ref $format eq 'ARRAY'
                or croak "Invalid Parse::Binary::Nested format: should be an array ref";
        ref $format eq 'ARRAY'
                or croak "Invalid Parse::Binary::Nested format: should be an array ref";

-       bless $format, $class;
+       bless [$format, $class->template($format)], $class;

 }
 
 sub template {
 }
 
 sub template {


@@ -39,14 +43,15 @@ sub convert {
        # map flat results into a named and nested hash
        my %res;
        $pos ||= \(my $_pos);
        # map flat results into a named and nested hash
        my %res;
        $pos ||= \(my $_pos);

-       while (my ($field, $template) = splice @$format, 0, 2) {
+       for (my $i = 0; $i < $#$format; $i += 2) {
+               my ($field, $template) = @$format[$i, $i+1];

                if (ref $template eq 'ARRAY') {
                        my ($count, @subformat) = @$template;
                        $$pos++ if $count eq 'C';
                        my $max = $count =~ s/^(\d+)// ? $1 : 0;
                        $count = !$count ? $max
                                : $count eq '*' ? $res{levelcount}->{total} : shift @$data;
                if (ref $template eq 'ARRAY') {
                        my ($count, @subformat) = @$template;
                        $$pos++ if $count eq 'C';
                        my $max = $count =~ s/^(\d+)// ? $1 : 0;
                        $count = !$count ? $max
                                : $count eq '*' ? $res{levelcount}->{total} : shift @$data;

-                       $res{$field}->[$_] = $self->convert([@subformat], $data, $pos)
+                       $res{$field}->[$_] = $self->convert(\@subformat, $data, $pos)

                                for 0 .. ($max || $count)-1;
                        splice @{ $res{$field} }, $count if $max > $count;
                        $res{$field} = $res{$field}->[0] if $max == 1;
                                for 0 .. ($max || $count)-1;
                        splice @{ $res{$field} }, $count if $max > $count;
                        $res{$field} = $res{$field}->[0] if $max == 1;


@@ -108,9 +113,11 @@ sub convert {
 }
 
 sub unpackf {
 }
 
 sub unpackf {

-       my ($self, $input) = @_;
-       my @data = unpack $self->template($self), $input;
-       return $self->convert([@$self], \@data);
+       my ($format, $input) = @_;
+       my $self = UNIVERSAL::isa($format, __PACKAGE__) ? $format
+               : __PACKAGE__->new($format);
+       my @data = unpack $self->[1], $input;
+       return $self->convert($self->[0], \@data);

 }
 
 1;
 }
 
 1;


@@ -121,7 +128,9 @@ Parse::Binary::Nested - Structured unpack
 
 =head1 SYNOPSIS
 
 
 =head1 SYNOPSIS
 

-       use Parse::Binary::Nested;
+       use Parse::Binary::Nested qw(unpackf);
+       my $data = unpackf([message => 'Z*'], "hi\0");
+

        my $parser = Parser::Binary::Nested->new([
                foos => [
                        'C', # count
        my $parser = Parser::Binary::Nested->new([
                foos => [
                        'C', # count


@@ -130,8 +139,7 @@ Parse::Binary::Nested - Structured unpack
                ],
                trail => 'a*',
        ]);
                ],
                trail => 'a*',
        ]);

-       
-       my $data = $parser->unpackf("\1foo\0.rest");
+       $data = $parser->unpackf("\1foo\0.rest");

        print $data->{foos}->[0]->{message};
 
 =head1 DESCRIPTION
        print $data->{foos}->[0]->{message};
 
 =head1 DESCRIPTION

diff --git a/parse-wormedit b/parse-wormedit
index 585c03a659d9c94343facb91e0335afd9e1fab8b..ed64118e23ef31f7f7f8fc8cce90c9b6427c7b9a 100755 (executable)
--- a/parse-wormedit
+++ b/parse-wormedit
@@ -19,7 +19,7 @@ package Shiar_Parse::WormEdit;
 use strict;
 use warnings;
 
 use strict;
 use warnings;
 

-use Parse::Binary::Nested;
+use Parse::Binary::Nested qw(unpackf);

 
 our %MAGICID = (
        "WormEdit053\000LVL" => 53,
 
 our %MAGICID = (
        "WormEdit053\000LVL" => 53,


@@ -153,7 +153,7 @@ sub read {
 
        # convert to an easily accessible hash
        push @FORMAT, -trail => 'a*';
 
        # convert to an easily accessible hash
        push @FORMAT, -trail => 'a*';

-       my $data = Parse::Binary::Nested->new(\@FORMAT)->unpackf($input);
+       my $data = unpackf(\@FORMAT, $input);

        warn "Trailing data left unparsed\n" if length delete $data->{-trail};
        $data->{format} = 'WormEdit';
        return $data;
        warn "Trailing data left unparsed\n" if length delete $data->{-trail};
        $data->{format} = 'WormEdit';
        return $data;


@@ -167,7 +167,7 @@ use warnings;
 
 use List::Util qw(sum min max);
 use Data::Dumper;
 
 use List::Util qw(sum min max);
 use Data::Dumper;

-use Parse::Binary::Nested;
+use Parse::Binary::Nested qw(unpackf);

 
 sub read {
        my ($self, $input) = @_;
 
 sub read {
        my ($self, $input) = @_;


@@ -293,7 +293,7 @@ sub read {
                }
        }
 
                }
        }
 

-       my $data = Parse::Binary::Nested->new(\@FORMAT)->unpackf($input);
+       my $data = unpackf(\@FORMAT, $input);

        my $offset = 0;
        $offsetbase += 1 + @{ $data->{sprite} } if $data->{sprite};
        $data->{moderef}->{offset}->{single} == $offsetbase
        my $offset = 0;
        $offsetbase += 1 + @{ $data->{sprite} } if $data->{sprite};
        $data->{moderef}->{offset}->{single} == $offsetbase

diff --git a/t/parser.t b/t/parser.t
index 5e53315d69f7fa99977e4a5f59c42df051a2ef61..faa229ce760b1e70cf3bfac574c58f2ed529e6e6 100644 (file)
--- a/t/parser.t
+++ b/t/parser.t
@@ -6,35 +6,53 @@ use warnings;
 use Test::More;
 use Data::Dumper;
 
 use Test::More;
 use Data::Dumper;
 

-plan tests => 6;
+plan tests => 7;

 
 use_ok('Parse::Binary::Nested');
 
 
 use_ok('Parse::Binary::Nested');
 

-my $example = Parse::Binary::Nested->new([
+my @example = (

        foos => [
                'C',
                message => 'Z*',
        foos => [
                'C',
                message => 'Z*',

-               period  => 'C',
+               period  => 'a',

        ],
        trail => 'a*',
        ],
        trail => 'a*',

-]);
-ok($example, 'example parser');
-my $data = $example->unpackf("\2foo\0!\0.rest");
-is(ref $data, 'HASH', 'output structure');
-is($data->{foos}->[1]->{period}, ord '.', 'sample element');
+);
+my $testdata = "\2foo\0!\0.rest";
+my $testresult = {
+       foos => [
+               {message => 'foo', period => '!'},
+               {message => '',    period => '.'},
+       ],
+       trail => 'rest',
+};
+
+my $parser = Parse::Binary::Nested->new(\@example);
+ok($parser, 'new object');
+is_deeply($parser->unpackf($testdata), $testresult, 'object unpackf');
+
+Parse::Binary::Nested->import('unpackf');
+is_deeply(
+       unpackf(\@example, $testdata),
+       $testresult,
+       'unprepared unpackf'
+);
+
+my @commonargs = ('cxaXv', "\1\2hi\0");
+is_deeply(
+       [ values %{ unpackf(@commonargs) } ],
+       [[ unpack($commonargs[0], $commonargs[1]) ]],
+       'unpack compatibility'
+);

 
 is_deeply(
 
 is_deeply(

-       Parse::Binary::Nested->new(
-               [ lstr => 'Ca3', rest => 'a*' ]
-       )->unpackf("\2quux"),
+       unpackf([ lstr => 'C/a3', rest => 'a*' ], "\2quux"),

        { lstr => 'qu', rest => 'x' },
        'length string'
 );
 
 is_deeply(
        { lstr => 'qu', rest => 'x' },
        'length string'
 );
 
 is_deeply(

-       Parse::Binary::Nested->new(
-               [ ignoreme => 'x2X', value => 'xC' ]
-       )->unpackf("\0\1\2"),
+       unpackf([ ignoreme => 'x2X', value => 'xC' ], "\0\1\2"),

        { value => 2 },
        'empty values'
 );
        { value => 2 },
        'empty values'
 );