Parse::Binary::Nested: byte-terminated groups

Feature ?$NUM count value to read until the specified byte is encountered.
Very good to cleanly declare nul-terminated objects.

diff --git a/Parse/Binary/Nested.pm b/Parse/Binary/Nested.pm
index 75c22fa897eacaa3335cccec230722f6db603d02..6b74f648d4f879e8eb09cb4732029e7506b3cc31 100644 (file)
--- a/Parse/Binary/Nested.pm
+++ b/Parse/Binary/Nested.pm
@@ -22,31 +22,63 @@ sub new {
 sub template {
        my ($self, $format) = @_;
        # total (flattened) unpack template from nested format definitions
-       return join '', map {
+       my $template = '';
+       @$format or return $template;
+       for (reverse 0 .. ($#$format - 1) >> 1) {
                my $value = $format->[-($_ << 1) - 1];
                if (ref $value eq 'ARRAY') {
                        my $count = $value->[0];
-                       $value = $self->template($value);
-                       $value = $count =~ s/^([*\d]+)// ? "$count($value)$1"
-                               : $count."X[$count]$count/($value)";
+                       if ($count =~ /^\?/) {
+                               $template .= 'a*';
+                               last;
+                       }
+                       else {
+                               $value = $self->template($value);
+                               $value = $count =~ s/^([*\d]+)// ? "$count($value)$1"
+                                       : $count."X[$count]$count/($value)";
+                       }
                }
                else {
                        $value =~ s/=(?:\d+|.)//g;  # hardcoded values
                        $value =~ s{^C/(a)(\d+)}{$1 . ($2 + 1)}e;  # maximum length
                }
-               $value;
-       } reverse 0 .. ($#$format - 1) >> 1;
+               $template .= $value;
+       }
+       return $template;
 }
 
 sub convert {
        my ($self, $format, $data, $pos) = @_;
        # map flat results into a named and nested hash
        my %res;
-       $pos ||= \(my $_pos);
+       $pos ||= \(my $_pos = 0);
        for (my $i = 0; $i < $#$format; $i += 2) {
                my ($field, $template) = @$format[$i, $i+1];
                if (ref $template eq 'ARRAY') {
                        my ($count, @subformat) = @$template;
+
+                       if ($count =~ /^\?(\d+)/) {
+                               # character-terminated group
+                               my $endmark = chr $1;
+                               my $iterate = ref($self)->new(\@subformat);
+                               push @{ $iterate->[0] }, -pos => '=.';
+                               my $subpos = 0;
+                               while ($subpos < length $data->[0]) {
+                                       last if substr($data->[0], $subpos, 1) eq $endmark;
+                                       my $iterdata = $iterate->convert($iterate->[0], [
+                                               unpack $iterate->[1], substr($data->[0], $subpos)
+                                       ]) or last;
+                                       $subpos += delete $iterdata->{-pos};
+                                       push @{ $res{$field} }, $iterdata;
+                               }
+                               $$pos += $subpos + 1;
+                               @$data = unpack(
+                                       $self->template([ @$format[$i+2 .. $#$format] ]),
+                                       substr($data->[0], $subpos + 1)
+                               ) if $subpos < length $data->[0];
+                               next;
+                       }
+
                        $$pos++ if $count eq 'C';
                        my $max = $count =~ s/^(\d+)// ? $1 : 0;
                        $count = !$count ? $max

diff --git a/parse-wormedit b/parse-wormedit
index ed64118e23ef31f7f7f8fc8cce90c9b6427c7b9a..77580676baee866cb3e67ad1a7fa4c6f41146143 100755 (executable)
--- a/parse-wormedit
+++ b/parse-wormedit
@@ -222,6 +222,10 @@ sub read {
                        line => 'B8',
                ],
                leveldata => 'a*',
+               #levels
+               #finish code
+               #levels-multi
+               #hinames
        );
        my @LEVELFORM = (
                peas       => 'C',
@@ -247,17 +251,13 @@ sub read {
                        y => 'C',
                        x => 'C',
                ],
-               #levels
-               #finish code
-               #levels-multi
-               #hinames
-       );
-       my @OBJECTFORM = (
+               objects    => ['?0',
                        type => 'C',
                        x1   => 'C',
                        y1   => 'C',
                        x2   => 'C',
                        y2   => 'C',
+               ],
        );
        my $offsetbase = 0xF080;
 
@@ -283,6 +283,7 @@ sub read {
                                $_->[13] = $_->[15];  # ctf
                                $_->[15] = 'domination';
                        } for @{ $FORMAT[9] }; # no multifood
+                       splice @LEVELFORM, -2;
                        push @LEVELFORM, "objects$_" => ['C',
                                type => "=$_",
                                map {$_ => 'C'} qw(x1 y1 x2 y2)
@@ -329,8 +330,8 @@ sub read {
                my @varform = @LEVELFORM;
                $varform[13]->[0] = $variant eq 'single' ? 1 : 4;
                unshift @varform, name => 'Z*' unless $variant eq 'single' or $version <= 91;
-               $varform[-1]->[0] = 1 if $variant eq 'race' and $version > 91;
-               $varform[-1]->[0] = 2 if $variant eq 'ctf';
+               $varform[-3]->[0] = 1 if $variant eq 'race' and $version > 91;
+               $varform[-3]->[0] = 2 if $variant eq 'ctf';
                push @varform, size => '=.';
                my $parselevel = Parse::Binary::Nested->new(\@varform);
 
@@ -344,13 +345,6 @@ sub read {
                        }
 
                        my $level = $parselevel->unpackf(substr $data->{leveldata}, $offset);
-                       my $size = 8  # unpack length (ugh, ugly recalculation)
-                               + (defined $level->{name} ? 1 + length $level->{name} : 0)
-                               + 3 * (ref $level->{worms} eq 'ARRAY' ? scalar @{$level->{worms}} : 1)
-                               + 2 * ($level->{flags} ? ref $level->{flags} eq 'ARRAY' ? scalar @{$level->{flags}} : 1 : 0)
-                               + ($level->{sprite} ? scalar @{$level->{sprite}} : 0)
-                               + ($level->{balls} ? 3 * scalar @{$level->{balls}} : 0);
-                       $level->{sizecalc} = $size;
                        $level->{offset} = $offset + $offsetbase;
 
                        # add objects until terminator
@@ -359,14 +353,6 @@ sub read {
                        ref $_ eq 'ARRAY' and push @{ $level->{objects} }, @$_
                                for map { delete $level->{"objects$_"} } 2, 3;
                }
-               else {
-                       while (my $object = ord substr($data->{leveldata}, $offset+$size, 1)) {
-                               push @{ $level->{objects} }, Parse::Binary::Nested->new([@OBJECTFORM])->unpackf(
-                                       substr $data->{leveldata}, $offset+$size, 5
-                               );
-                               $size += 5;
-                       }
-               }
 
                        # add parsed level and advance
                        push @{ $data->{levels} }, $level;

diff --git a/t/parser.t b/t/parser.t
index faa229ce760b1e70cf3bfac574c58f2ed529e6e6..8e386634bc3785ce97a8d655f573769797bbba73 100644 (file)
--- a/t/parser.t
+++ b/t/parser.t
@@ -6,7 +6,7 @@ use warnings;
 use Test::More;
 use Data::Dumper;
 
-plan tests => 7;
+plan tests => 11;
 
 use_ok('Parse::Binary::Nested');
 
@@ -57,3 +57,56 @@ is_deeply(
        'empty values'
 );
 
+is_deeply(
+       unpackf([
+               begin => 'c',
+               asciiz => ['?0', lead => 'v', string => 'Z*'],
+               end   => 'c',
+       ], "\377\1\0Hi\0\2\0zer0\0\0\376"),
+       {
+               begin => -1,
+               asciiz => [
+                       { lead => 1, string => 'Hi' },
+                       { lead => 2, string => 'zer0' },
+               ],
+               end => -2,
+       },
+       'zero-terminated group'
+);
+
+my $looptest = Parse::Binary::Nested->new([
+       begin => 'xc',
+       loop  => ['?1', lead => 'c', string => 'Z*'],
+       end   => '=.',
+]);
+is_deeply(
+       $looptest->unpackf("\0\1\0Hello\0\377bye"),
+       {
+               begin => 1,
+               loop => [
+                       { lead =>  0, string => 'Hello' },
+                       { lead => -1, string => 'bye' },
+               ],
+               end => 15,
+       },
+       'unterminated group'
+);
+is_deeply(
+       $looptest->unpackf("\0\1\1trailing"),
+       {
+               begin => 1,
+               end => 3,
+       },
+       'preterminated group'
+);
+
+is_deeply(
+       unpackf([
+               loop => ['?0', byte => 'C'],
+       ], "\1\2\3"),
+       {
+               loop => [map { {byte => $_} } 1..3],
+       },
+       'last byte in unterminated loop'
+);
+