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

[wormy.git] / Parse / Binary / Nested.pm

diff --git a/Parse/Binary/Nested.pm b/Parse/Binary/Nested.pm
index 371a65b47dbf76ff9d9893a560c5e8a1e8f1fdf9..6b74f648d4f879e8eb09cb4732029e7506b3cc31 100644 (file)
--- a/Parse/Binary/Nested.pm
+++ b/Parse/Binary/Nested.pm
@@ -5,48 +5,85 @@ use strict;
 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) = @_;
+       ref $format
+               or $format = [0 => $format];
        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 {
        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);
-       while (my ($field, $template) = splice @$format, 0, 2) {
+       $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
                                : $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;
@@ -108,9 +145,11 @@ sub convert {
 }
 
 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;
@@ -121,7 +160,9 @@ Parse::Binary::Nested - Structured unpack
 
 =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
@@ -130,8 +171,7 @@ Parse::Binary::Nested - Structured unpack
                ],
                trail => 'a*',
        ]);
-       
-       my $data = $parser->unpackf("\1foo\0.rest");
+       $data = $parser->unpackf("\1foo\0.rest");
        print $data->{foos}->[0]->{message};
 
 =head1 DESCRIPTION