From: Mischa Poslawsky <wormy@shiar.org>
Date: Mon, 2 Mar 2009 16:25:12 +0000 (+0100)
Subject: parse-wormedit: seperate parsing module Parse::Binary::Nested
X-Git-Url: http://git.shiar.nl/wormy.git/commitdiff_plain/3f547138025ead9303d443e1d41e5e4c884c570d

parse-wormedit: seperate parsing module Parse::Binary::Nested

Make the package a (mostly) stand-alone include, potientially reusable by
other projects, but primarily keeping it more maintainable (uncluttered
code, testable, and allowing futher modularisation of file parsers).
---

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.
+
diff --git a/parse-wormedit b/parse-wormedit
index 84e4e31..3811863 100755
--- a/parse-wormedit
+++ b/parse-wormedit
@@ -6,7 +6,7 @@ use 5.010;
 use Data::Dumper;
 use Getopt::Long 2.33 qw(HelpMessage :config bundling);
 
-our $VERSION = '1.03';
+our $VERSION = '1.04';
 
 GetOptions(\my %opt,
 	'raw|r',  # full output
@@ -19,6 +19,8 @@ package Shiar_Parse::WormEdit;
 use strict;
 use warnings;
 
+use Parse::Binary::Nested;
+
 our %MAGICID = (
 	"WormEdit053\000LVL" => 53,
 	"WormEdit\34195\000LVL" => 95,
@@ -149,9 +151,9 @@ sub read {
 	}
 
 	# convert to an easily accessible hash
-	my @values = unpack Shiar_Parse::Nested->template(\@FORMAT).'a*', $input;
-	my $data = Shiar_Parse::Nested->convert(\@FORMAT, \@values);
-	warn "Trailing data left unparsed\n" if grep {length} @values;
+	push @FORMAT, -trail => 'a*';
+	my $data = Parse::Binary::Nested->new(\@FORMAT)->unpackf($input);
+	warn "Trailing data left unparsed\n" if length delete $data->{-trail};
 	$data->{format} = 'WormEdit';
 	return $data;
 }
@@ -164,6 +166,7 @@ use warnings;
 
 use List::Util qw(sum min max);
 use Data::Dumper;
+use Parse::Binary::Nested;
 
 sub read {
 	my ($self, $input) = @_;
@@ -288,7 +291,7 @@ sub read {
 		}
 	}
 
-	my $data = Shiar_Parse::Nested->unpack(\@FORMAT, $input);
+	my $data = Parse::Binary::Nested->new(\@FORMAT)->unpackf($input);
 	my $offset = 0;
 	$offsetbase += 1 + @{ $data->{sprite} } if $data->{sprite};
 	$data->{moderef}->{offset}->{single} == $offsetbase
@@ -326,6 +329,7 @@ sub read {
 		unshift @varform, name => 'Z*' unless $variant eq 'single' or $version <= 91;
 		$varform[-1]->[0] = 1 if $variant eq 'race' and $version > 91;
 		$varform[-1]->[0] = 2 if $variant eq 'ctf';
+		my $parselevel = Parse::Binary::Nested->new(\@varform);
 
 		while ($offset < length $data->{leveldata}) {
 			last if substr($data->{leveldata}, $offset, 1) eq chr(255);
@@ -336,9 +340,7 @@ sub read {
 				$data->{moderef}->{start}->{$mode} = 1 + scalar @{ $data->{levels} };
 			}
 
-			my $level = Shiar_Parse::Nested->unpack(
-				[@varform], substr $data->{leveldata}, $offset
-			);
+			my $level = $parselevel->unpackf(substr $data->{leveldata}, $offset);
 			my $size = 8  # unpack length (ugh, ugly recalculation)
 				+ (defined $level->{name} ? 1 + length $level->{name} : 0)
 				+ 3 * (ref $level->{worms} eq 'ARRAY' ? scalar @{$level->{worms}} : 1)
@@ -357,8 +359,8 @@ sub read {
 		}
 		else {
 			while (my $object = ord substr($data->{leveldata}, $offset+$size, 1)) {
-				push @{ $level->{objects} }, Shiar_Parse::Nested->unpack(
-					[@OBJECTFORM], substr($data->{leveldata}, $offset+$size, 5)
+				push @{ $level->{objects} }, Parse::Binary::Nested->new([@OBJECTFORM])->unpackf(
+					substr $data->{leveldata}, $offset+$size, 5
 				);
 				$size += 5;
 			}
@@ -411,56 +413,6 @@ sub read {
 }
 
 
-package Shiar_Parse::Nested;
-
-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] = CORE::unpack 'C/a', $data->[0];
-		}
-		$res{$field} = shift @$data;
-	}
-	return \%res;
-}
-
-sub unpack {
-	my ($self, $format, $input) = @_;
-	my @data = CORE::unpack $self->template($format), $input;
-	return $self->convert($format, \@data);
-}
-
-
 package main;
 
 my @OBJTYPE = ('none', 'line', 'fat line', 'bar', 'circle');
diff --git a/t/parser.t b/t/parser.t
new file mode 100644
index 0000000..cebd099
--- /dev/null
+++ b/t/parser.t
@@ -0,0 +1,33 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Data::Dumper;
+
+plan tests => 5;
+
+use_ok('Parse::Binary::Nested');
+
+my $example = Parse::Binary::Nested->new([
+	foos => [
+		'C',
+		message => 'Z*',
+		period  => 'C',
+	],
+	trail => 'a*',
+]);
+ok($example, 'example parser');
+my $data = $example->unpackf("\2foo\0!\0.rest");
+is(ref $data, 'HASH', 'output structure');
+is($data->{foos}->[1]->{period}, ord '.', 'sample element');
+
+is_deeply(
+	Parse::Binary::Nested->new(
+		[ lstr => 'Ca3', rest => 'a*' ]
+	)->unpackf("\2quux"),
+	{ lstr => 'qu', rest => 'x' },
+	'length string'
+);
+