From: Mischa Poslawsky <wormy@shiar.org>
Date: Tue, 3 Mar 2009 17:59:16 +0000 (+0100)
Subject: Parse::Binary::Nested: track parsed bytes
X-Git-Url: http://git.shiar.nl/wormy.git/commitdiff_plain/ce0df5c87882d5275a22ab3bb3f5642c577927b6?hp=5f543f9395f3a885ee9b751e98d069b9ed54f885

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 872ccaa..371a65b 100644
--- 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 5761a30..585c03a 100755
--- 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;
 		}