Feature ?$NUM count value to read until the specified byte is encountered.
Very good to cleanly declare nul-terminated objects.
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
line => 'B8',
],
leveldata => 'a*',
+ #levels
+ #finish code
+ #levels-multi
+ #hinames
);
my @LEVELFORM = (
peas => 'C',
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;
$_->[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)
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);
}
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
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;
use Test::More;
use Data::Dumper;
-plan tests => 7;
+plan tests => 11;
use_ok('Parse::Binary::Nested');
'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'
+);
+