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                 $res{$field} = shift @$data;
  54         }
  55         return \%res;
  56 }
  57
  58 sub unpackf {
  59         my ($self, $input) = @_;
  60         my @data = unpack $self->template($self), $input;
  61         return $self->convert([@$self], \@data);
  62 }
  63
  64 1;
  65
  66 =head1 NAME
  67
  68 Parse::Binary::Nested - Structured unpack
  69
  70 =head1 SYNOPSIS
  71
  72         use Parse::Binary::Nested;
  73         my $parser = Parser::Binary::Nested->new([
  74                 foos => [
  75                         'C', # count
  76                         message => 'Z*',
  77                         period  => 'C',
  78                 ],
  79                 trail => 'a*',
  80         ]);
  81
  82         my $data = $parser->unpackf("\1foo\0.rest");
  83         print $data->{foos}->[0]->{message};
  84
  85 =head1 DESCRIPTION
  86
  87 =head1 AUTHOR
  88
  89 Mischa POSLAWSKY <perl@shiar.org>
  90
  91 =head1 LICENSE
  92
  93 GPL version 3.
  94