Parse::Binary::Nested: track parsed bytes

Reparse template values ourself, in order to:
- Put multiple data in a single value (for example 'CC' will return
  an array with the two bytes, instead of screwing up all following
  elements);
- Know the amount of bytes read, allowing the current position to be
  returned by the special '=.' declaration.

Also, the special case 'Ca$NUM' is now to be given as 'C/a$NUM'.
This solution should be much better (logically combines C/a and a$NUM)
and unambiguous (this syntax is invalid with CORE::unpack, so no
unexpected results).

diff --git a/Parse/Binary/Nested.pm b/Parse/Binary/Nested.pm
index 872ccaac1e772d0b97384c1b93b2307cd8f0f715..371a65b47dbf76ff9d9893a560c5e8a1e8f1fdf9 100644 (file)
--- a/Parse/Binary/Nested.pm
+++ b/Parse/Binary/Nested.pm
@@ -1,11 +1,12 @@
 package Parse::Binary::Nested;
 
+use 5.010;
 use strict;
 use warnings;
 
 use Carp;
 
-our $VERSION = '1.01';
+our $VERSION = '1.02';
 
 sub new {
        my ($class, $format) = @_;
@@ -26,39 +27,82 @@ sub template {
                                : $count."X[$count]$count/($value)";
                }
                else {
-                       $value =~ s/=\d*//g;  # hardcoded values
-                       $value =~ s/^C(a)(\d+)/$1 . ($2 + 1)/e;  # length prefix
+                       $value =~ s/=(?:\d+|.)//g;  # hardcoded values
+                       $value =~ s{^C/(a)(\d+)}{$1 . ($2 + 1)}e;  # maximum length
                }
                $value;
        } reverse 0 .. ($#$format - 1) >> 1;
 }
 
 sub convert {
-       my ($self, $format, $data) = @_;
+       my ($self, $format, $data, $pos) = @_;
        # map flat results into a named and nested hash
        my %res;
+       $pos ||= \(my $_pos);
        while (my ($field, $template) = splice @$format, 0, 2) {
                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) for 0 .. ($max || $count)-1;
+                       $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;
                        next;
                }
-               elsif ($template =~ /^Ca/) {
-                       $data->[0] = unpack 'C/a', $data->[0];
-               }
-               elsif ($template =~ /^(?:[xX]\d*)*$/) {
-                       next;  # no values
-               }
-               elsif ($template =~ /=(\d+)?/) {
-                       $res{$field} = $1;
-                       next;
+               else {
+                       for (split m{(?![0-9*/])(?<![/=])}, $template) {
+                               my ($type, $count) = m{^(\D+)(\d+)?$} or die 'unsupported';
+                               my $mult = $count // 1;
+                               given ($type) {
+                                       when (['c', 'C']) {
+                                               $$pos += $mult;
+                                       }
+                                       when ('x') {
+                                               $$pos += $mult;
+                                               next;
+                                       }
+                                       when (['b', 'B']) {
+                                               $$pos++;
+                                       }
+                                       when (['s', 'S', 'n', 'v']) {
+                                               $$pos += $mult * 2;
+                                       }
+                                       when (['a', 'A', 'Z', 'a*']) {
+                                               $$pos += length $data->[0];
+                                       }
+                                       when ('Z*') {
+                                               $$pos += $count // 1 + length $data->[0];
+                                       }
+                                       when (['C/a', 'C/A']) {
+                                               $$pos += 1 + ($count // length $data->[0]);
+                                               $data->[0] = unpack 'C/a', $data->[0] if defined $count;
+                                       }
+                                       when ('=') {
+                                               unshift @$data, $count;
+                                       }
+                                       when ('=.') {
+                                               unshift @$data, $$pos;
+                                       }
+                                       when ('X') {
+                                               $$pos -= $mult;
+                                               next;
+                                       }
+                                       default {
+                                               carp "Unrecognised template element '$type'";
+                                       }
+                               }
+                               if (defined $res{$field}) {
+                                       $res{$field} = [ $res{$field} ] unless ref $res{$field} eq 'ARRAY';
+                                       push @{ $res{$field} }, shift @$data;
+                               }
+                               else {
+                                       $res{$field} = shift @$data;
+                               }
+                       }
                }
-               $res{$field} = shift @$data;
        }
        return \%res;
 }

diff --git a/parse-wormedit b/parse-wormedit
index 5761a30107a585d2af0f172d9e607c9a05b1fb26..585c03a659d9c94343facb91e0335afd9e1fab8b 100755 (executable)
--- a/parse-wormedit
+++ b/parse-wormedit
@@ -31,8 +31,8 @@ our %MAGICID = (
 my @FORMAT = (
        magic       => 'a15',
        version     => 'C',
-       name        => 'Ca32',
-       description => 'Ca64x256',
+       name        => 'C/a32',
+       description => 'C/a64x256',
        levelcount  => [1,
                single => 'C',
                multi  => 'C',
@@ -59,14 +59,14 @@ my @FORMAT = (
        ],
        finish      => [1,
                type    => 's',
-               message => 'Ca255',
-               code    => 'Ca255',
+               message => 'C/a255',
+               code    => 'C/a255',
                reserved=> 'x256',
        ],
        hiname      => 'a3',
        levels      => ['*', # levelcount->total actually
-               id         => 'Ca22',
-               name       => 'Ca22',
+               id         => 'C/a22',
+               name       => 'C/a22',
                size       => 'C',
                peas       => 'C',
                delay      => 'C',
@@ -131,7 +131,7 @@ sub read {
        $fileversion += 100 if $fileversion < 90;  # 93..95 came before 50..53
        given ($fileversion) {
                when (153) { } # current @FORMAT
-                       $FORMAT[7] = 'Ca64'; # no reserved space after description
+                       $FORMAT[7] = 'C/a64'; # no reserved space after description
                        splice @{ $FORMAT[15] }, -2; # finish reserve
                        $FORMAT[-1]->[-1]->[0] = '32C'; # less objects
                        ref $_ and pop @$_ for @{ $FORMAT[11] }; # 9 moderefs
@@ -331,6 +331,7 @@ sub read {
                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';
+               push @varform, size => '=.';
                my $parselevel = Parse::Binary::Nested->new(\@varform);
 
                while ($offset < length $data->{leveldata}) {
@@ -349,7 +350,7 @@ sub read {
                                + 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->{size} = $size;
+                       $level->{sizecalc} = $size;
                        $level->{offset} = $offset + $offsetbase;
 
                        # add objects until terminator
@@ -357,7 +358,6 @@ sub read {
                if ($version <= 91) {
                        ref $_ eq 'ARRAY' and push @{ $level->{objects} }, @$_
                                for map { delete $level->{"objects$_"} } 2, 3;
-                       $size += 1 + 4 * scalar @{ $level->{objects} };
                }
                else {
                        while (my $object = ord substr($data->{leveldata}, $offset+$size, 1)) {
@@ -370,7 +370,7 @@ sub read {
 
                        # add parsed level and advance
                        push @{ $data->{levels} }, $level;
-                       $offset += ++$size;
+                       $offset += $level->{size};
                        last if ++$data->{levelcount}->{$variant} >= $amount;
                }