Parse/Binary/Nested.pm

   1 package Parse::Binary::Nested;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Carp;
   7
   8 our $VERSION = '1.01';
   9
  10 sub new {
  11         my ($class, $format) = @_;
  12         ref $format eq 'ARRAY'
  13                 or croak "Invalid Parse::Binary::Nested format: should be an array ref";
  14         bless $format, $class;
  15 }
  16
  17 sub template {
  18         my ($self, $format) = @_;
  19         # total (flattened) unpack template from nested format definitions
  20         return join '', map {
  21                 my $value = $format->[-($_ << 1) - 1];
  22                 if (ref $value eq 'ARRAY') {
  23                         my $count = $value->[0];
  24                         $value = $self->template($value);
  25                         $value = $count =~ s/^([*\d]+)// ? "$count($value)$1"
  26                                 : $count."X[$count]$count/($value)";
  27                 }
  28                 else {
  29                         $value =~ s/=\d*//g;  # hardcoded values
  30                         $value =~ s/^C(a)(\d+)/$1 . ($2 + 1)/e;  # length prefix
  31                 }
  32                 $value;
  33         } reverse 0 .. ($#$format - 1) >> 1;
  34 }
  35
  36 sub convert {
  37         my ($self, $format, $data) = @_;
  38         # map flat results into a named and nested hash
  39         my %res;
  40         while (my ($field, $template) = splice @$format, 0, 2) {
  41                 if (ref $template eq 'ARRAY') {
  42                         my ($count, @subformat) = @$template;
  43                         my $max = $count =~ s/^(\d+)// ? $1 : 0;
  44                         $count = !$count ? $max
  45                                 : $count eq '*' ? $res{levelcount}->{total} : shift @$data;
  46                         $res{$field}->[$_] = $self->convert([@subformat], $data) for 0 .. ($max || $count)-1;
  47                         splice @{ $res{$field} }, $count if $max > $count;
  48                         $res{$field} = $res{$field}->[0] if $max == 1;
  49                         next;
  50                 }
  51                 elsif ($template =~ /^Ca/) {
  52                         $data->[0] = unpack 'C/a', $data->[0];
  53                 }
  54                 elsif ($template =~ /^(?:[xX]\d*)*$/) {
  55                         next;  # no values
  56                 }
  57                 elsif ($template =~ /=(\d+)?/) {
  58                         $res{$field} = $1;
  59                         next;
  60                 }
  61                 $res{$field} = shift @$data;
  62         }
  63         return \%res;
  64 }
  65
  66 sub unpackf {
  67         my ($self, $input) = @_;
  68         my @data = unpack $self->template($self), $input;
  69         return $self->convert([@$self], \@data);
  70 }
  71
  72 1;
  73
  74 =head1 NAME
  75
  76 Parse::Binary::Nested - Structured unpack
  77
  78 =head1 SYNOPSIS
  79
  80         use Parse::Binary::Nested;
  81         my $parser = Parser::Binary::Nested->new([
  82                 foos => [
  83                         'C', # count
  84                         message => 'Z*',
  85                         period  => 'C',
  86                 ],
  87                 trail => 'a*',
  88         ]);
  89
  90         my $data = $parser->unpackf("\1foo\0.rest");
  91         print $data->{foos}->[0]->{message};
  92
  93 =head1 DESCRIPTION
  94
  95 Converts a string into a hash of values, just like C<unpack>
  96 except that it allows you to name and nest the resulting elements.
  97
  98 Format declarations are simalar to C<pack> templates,
  99 with the following additions:
 100
 101 =over
 102
 103 =item *
 104
 105 An array ref groups additional declarations,
 106 with the first value specifying a repetition.  If this count is variable,
 107 the resulting value will be an array ref of hashes.
 108
 109         repeat => ['C', name => 'a*', value => 'S']
 110
 111 With a count of 1, it will return only a hash ref,
 112 thereby simply grouping declarations:
 113
 114         test_foo => 'C'
 115         test => [1, foo => 'C']
 116
 117 =item *
 118
 119 A template value of C<Ca$length> is recognised as a length-preceded string
 120 with a constant (maximal) size, and will return only the string adjusted
 121 to its length.
 122 This behaviour is very similar to C<(C/a@x$length)>, except that it never reads
 123 more than the given number of bytes.
 124
 125 =item *
 126
 127 Hardcoded values can be inserted using C<=$number> values.
 128 This can for example be useful to retain forwards-compatibility:
 129
 130         rows => ['C',
 131                 type => '=1', # nothing read
 132                 data => 'S',
 133         ]
 134
 135         rows => ['C',
 136                 type => 'C',
 137                 data => 'S',
 138         ]
 139
 140 =back
 141
 142 =head1 AUTHOR
 143
 144 Mischa POSLAWSKY <perl@shiar.org>
 145
 146 =head1 LICENSE
 147
 148 GPL version 3.
 149