1 package Parse::Binary::Nested;
6 use experimental 'switch';
9 use Exporter qw(import);
11 our $VERSION = '1.10';
12 our @EXPORT_OK = qw(unpackf);
15 my ($class, $format) = @_;
17 or $format = [0 => $format];
18 ref $format eq 'ARRAY'
19 or croak "Invalid Parse::Binary::Nested format: should be an array ref";
20 bless [$format, $class->template($format)], $class;
24 my ($self, $format) = @_;
25 # total (flattened) unpack template from nested format definitions
27 @$format or return $template;
28 for (reverse 0 .. ($#$format - 1) >> 1) {
29 my $value = $format->[-($_ << 1) - 1];
30 if (ref $value eq 'ARRAY') {
31 my $count = $value->[0];
32 if ($count =~ /^\?/) {
37 $value = $self->template($value);
38 $value = $count =~ s/^([*\d]+)// ? "$count($value)$1"
39 : $count."X[$count]$count/($value)";
43 $value =~ s/=(?:\d+|.)//g; # hardcoded values
44 $value =~ s{^C/(a)(\d+)}{$1 . ($2 + 1)}e; # maximum length
52 my ($self, $format, $data, $pos) = @_;
53 # map flat results into a named and nested hash
55 $pos ||= \(my $_pos = 0);
56 for (my $i = 0; $i < $#$format; $i += 2) {
57 my ($field, $template) = @$format[$i, $i+1];
58 if (ref $template eq 'ARRAY') {
59 my ($count, @subformat) = @$template;
61 if ($count =~ /^\?(\d+)/) {
62 # character-terminated group
64 my $iterate = ref($self)->new(\@subformat);
65 push @{ $iterate->[0] }, -pos => '=.';
67 while ($subpos < length $data->[0]) {
68 last if substr($data->[0], $subpos, 1) eq $endmark;
69 my $iterdata = $iterate->convert($iterate->[0], [
70 unpack $iterate->[1], substr($data->[0], $subpos)
72 $subpos += delete $iterdata->{-pos};
73 push @{ $res{$field} }, $iterdata;
77 $self->template([ @$format[$i+2 .. $#$format] ]),
78 substr($data->[0], $subpos + 1)
79 ) if $subpos < length $data->[0];
83 $$pos++ if $count eq 'C';
84 my $max = $count =~ s/^(\d+)// ? $1 : 0;
85 $count = !$count ? $max
86 : $count eq '*' ? $res{levelcount}->{total} : shift @$data;
87 $res{$field}->[$_] = $self->convert(\@subformat, $data, $pos)
88 for 0 .. ($max || $count)-1;
89 splice @{ $res{$field} }, $count if $max > $count;
90 $res{$field} = $res{$field}->[0] if $max == 1;
94 for (split m{(?![0-9*/])(?<![/=])}, $template) {
95 my ($type, $count) = m{^(\D+)(\d+)?$} or die 'unsupported';
96 my $mult = $count // 1;
108 when (['s', 'S', 'n', 'v']) {
111 when (['a', 'A', 'Z', 'a*']) {
112 $$pos += length $data->[0];
115 $$pos += $count // 1 + length $data->[0];
117 when (['C/a', 'C/A']) {
118 $$pos += 1 + ($count // length $data->[0]);
119 $data->[0] = unpack 'C/a', $data->[0] if defined $count;
122 unshift @$data, $count;
125 unshift @$data, $$pos;
132 carp "Unrecognised template element '$type'";
135 if (defined $res{$field}) {
136 $res{$field} = [ $res{$field} ] unless ref $res{$field} eq 'ARRAY';
137 push @{ $res{$field} }, shift @$data;
140 $res{$field} = shift @$data;
149 my ($format, $input) = @_;
150 my $self = UNIVERSAL::isa($format, __PACKAGE__) ? $format
151 : __PACKAGE__->new($format);
152 my @data = unpack $self->[1], $input;
153 return $self->convert($self->[0], \@data);
160 Parse::Binary::Nested - Structured unpack
164 use Parse::Binary::Nested qw(unpackf);
165 my $data = unpackf([message => 'Z*'], "hi\0");
167 my $parser = Parser::Binary::Nested->new([
175 $data = $parser->unpackf("\1foo\0.rest");
176 print $data->{foos}->[0]->{message};
180 Converts a string into a hash of values, just like C<unpack>
181 except that it allows you to name and nest the resulting elements.
183 Format declarations are simalar to C<pack> templates,
184 with the following additions:
190 An array ref groups additional declarations,
191 with the first value specifying a repetition. If this count is variable,
192 the resulting value will be an array ref of hashes.
194 repeat => ['C', name => 'a*', value => 'S']
196 With a count of 1, it will return only a hash ref,
197 thereby simply grouping declarations:
200 test => [1, foo => 'C']
204 A template value of C<Ca$length> is recognised as a length-preceded string
205 with a constant (maximal) size, and will return only the string adjusted
207 This behaviour is very similar to C<(C/a@x$length)>, except that it never reads
208 more than the given number of bytes.
212 Hardcoded values can be inserted using C<=$number> values.
213 This can for example be useful to retain forwards-compatibility:
216 type => '=1', # nothing read
229 Mischa POSLAWSKY <perl@shiar.org>