Parse::Binary::Nested: simple non-OO unpackf

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

diff --git a/Parse/Binary/Nested.pm b/Parse/Binary/Nested.pm
index 9bac394264d2a35709bc5fc4caa255c18ac944f0..75c22fa897eacaa3335cccec230722f6db603d02 100644 (file)
--- a/Parse/Binary/Nested.pm
+++ b/Parse/Binary/Nested.pm
@@ -1,17 +1,22 @@
 package Parse::Binary::Nested;
 
+use 5.010;
 use strict;
 use warnings;
 
 use Carp;
+use Exporter qw(import);
 
-our $VERSION = '1.00';
+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 {
@@ -26,42 +31,93 @@ sub template {
                                : $count."X[$count]$count/($value)";
                }
                else {
-                       $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;
-       while (my ($field, $template) = splice @$format, 0, 2) {
+       $pos ||= \(my $_pos);
+       for (my $i = 0; $i < $#$format; $i += 2) {
+               my ($field, $template) = @$format[$i, $i+1];
                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
+               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;
 }
 
 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;
@@ -72,7 +128,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
@@ -81,8 +139,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
@@ -117,6 +174,21 @@ to its length.
 This behaviour is very similar to C<(C/a@x$length)>, except that it never reads
 more than the given number of bytes.
 
+=item *
+
+Hardcoded values can be inserted using C<=$number> values.
+This can for example be useful to retain forwards-compatibility:
+
+       rows => ['C',
+               type => '=1', # nothing read
+               data => 'S',
+       ]
+       
+       rows => ['C',
+               type => 'C',
+               data => 'S',
+       ]
+
 =back
 
 =head1 AUTHOR