X-Git-Url: http://git.shiar.nl/wormy.git/blobdiff_plain/7c64957ec9a87cf71ccf5fa7c28bb8c37b27efc6..3f547138025ead9303d443e1d41e5e4c884c570d:/Parse/Binary/Nested.pm

diff --git a/Parse/Binary/Nested.pm b/Parse/Binary/Nested.pm
new file mode 100644
index 0000000..db5e208
--- /dev/null
+++ b/Parse/Binary/Nested.pm
@@ -0,0 +1,94 @@
+package Parse::Binary::Nested;
+
+use strict;
+use warnings;
+
+use Carp;
+
+our $VERSION = '1.00';
+
+sub new {
+	my ($class, $format) = @_;
+	ref $format eq 'ARRAY'
+		or croak "Invalid Parse::Binary::Nested format: should be an array ref";
+	bless $format, $class;
+}
+
+sub template {
+	my ($self, $format) = @_;
+	# total (flattened) unpack template from nested format definitions
+	return join '', map {
+		my $value = $format->[-($_ << 1) - 1];
+		if (ref $value eq 'ARRAY') {
+			my $count = $value->[0];
+			$value = $self->template($value);
+			$value = $count =~ s/^([*\d]+)// ? "$count($value)$1"
+				: $count."X[$count]$count/($value)";
+		}
+		else {
+			$value =~ s/^C(a)(\d+)/$1 . ($2 + 1)/e;  # length prefix
+		}
+		$value;
+	} reverse 0 .. ($#$format - 1) >> 1;
+}
+
+sub convert {
+	my ($self, $format, $data) = @_;
+	# map flat results into a named and nested hash
+	my %res;
+	while (my ($field, $template) = splice @$format, 0, 2) {
+		if (ref $template eq 'ARRAY') {
+			my ($count, @subformat) = @$template;
+			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;
+			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];
+		}
+		$res{$field} = shift @$data;
+	}
+	return \%res;
+}
+
+sub unpackf {
+	my ($self, $input) = @_;
+	my @data = unpack $self->template($self), $input;
+	return $self->convert([@$self], \@data);
+}
+
+1;
+
+=head1 NAME
+
+Parse::Binary::Nested - Structured unpack
+
+=head1 SYNOPSIS
+
+	use Parse::Binary::Nested;
+	my $parser = Parser::Binary::Nested->new([
+		foos => [
+			'C', # count
+			message => 'Z*',
+			period  => 'C',
+		],
+		trail => 'a*',
+	]);
+	
+	my $data = $parser->unpackf("\1foo\0.rest");
+	print $data->{foos}->[0]->{message};
+
+=head1 DESCRIPTION
+
+=head1 AUTHOR
+
+Mischa POSLAWSKY <perl@shiar.org>
+
+=head1 LICENSE
+
+GPL version 3.
+