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.00';
   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/^C(a)(\d+)/$1 . ($2 + 1)/e;  # length prefix
  30                 }
  31                 $value;
  32         } reverse 0 .. ($#$format - 1) >> 1;
  33 }
  34
  35 sub convert {
  36         my ($self, $format, $data) = @_;
  37         # map flat results into a named and nested hash
  38         my %res;
  39         while (my ($field, $template) = splice @$format, 0, 2) {
  40                 if (ref $template eq 'ARRAY') {
  41                         my ($count, @subformat) = @$template;
  42                         my $max = $count =~ s/^(\d+)// ? $1 : 0;
  43                         $count = !$count ? $max
  44                                 : $count eq '*' ? $res{levelcount}->{total} : shift @$data;
  45                         $res{$field}->[$_] = $self->convert([@subformat], $data) for 0 .. ($max || $count)-1;
  46                         splice @{ $res{$field} }, $count if $max > $count;
  47                         $res{$field} = $res{$field}->[0] if $max == 1;
  48                         next;
  49                 }
  50                 elsif ($template =~ /^Ca/) {
  51                         $data->[0] = unpack 'C/a', $data->[0];
  52                 }
  53                 elsif ($template =~ /^(?:[xX]\d*)*$/) {
  54                         next;  # no values
  55                 }
  56                 $res{$field} = shift @$data;
  57         }
  58         return \%res;
  59 }
  60
  61 sub unpackf {
  62         my ($self, $input) = @_;
  63         my @data = unpack $self->template($self), $input;
  64         return $self->convert([@$self], \@data);
  65 }
  66
  67 1;
  68
  69 =head1 NAME
  70
  71 Parse::Binary::Nested - Structured unpack
  72
  73 =head1 SYNOPSIS
  74
  75         use Parse::Binary::Nested;
  76         my $parser = Parser::Binary::Nested->new([
  77                 foos => [
  78                         'C', # count
  79                         message => 'Z*',
  80                         period  => 'C',
  81                 ],
  82                 trail => 'a*',
  83         ]);
  84
  85         my $data = $parser->unpackf("\1foo\0.rest");
  86         print $data->{foos}->[0]->{message};
  87
  88 =head1 DESCRIPTION
  89
  90 Converts a string into a hash of values, just like C<unpack>
  91 except that it allows you to name and nest the resulting elements.
  92
  93 Format declarations are simalar to C<pack> templates,
  94 with the following additions:
  95
  96 =over
  97
  98 =item *
  99
 100 An array ref groups additional declarations,
 101 with the first value specifying a repetition.  If this count is variable,
 102 the resulting value will be an array ref of hashes.
 103
 104         repeat => ['C', name => 'a*', value => 'S']
 105
 106 With a count of 1, it will return only a hash ref,
 107 thereby simply grouping declarations:
 108
 109         test_foo => 'C'
 110         test => [1, foo => 'C']
 111
 112 =item *
 113
 114 A template value of C<Ca$length> is recognised as a length-preceded string
 115 with a constant (maximal) size, and will return only the string adjusted
 116 to its length.
 117 This behaviour is very similar to C<(C/a@x$length)>, except that it never reads
 118 more than the given number of bytes.
 119
 120 =back
 121
 122 =head1 AUTHOR
 123
 124 Mischa POSLAWSKY <perl@shiar.org>
 125
 126 =head1 LICENSE
 127
 128 GPL version 3.
 129