File Coverage

blib/lib/Geo/Parse/PolishFormat.pm

Criterion	Covered	Total	%
statement	12	51	23.5
branch	0	18	0.0
condition	0	4	0.0
subroutine	4	7	57.1
pod	0	2	0.0
total	16	82	19.5

package Geo::Parse::PolishFormat;

use 5.008008;
use strict;
use warnings;

use Data::Dumper;

our $VERSION = '0.02';

sub new {

	my $package = shift;

	my %options = @_;

	$options {get_split_depth} ||= sub {

		my ($name) = @_;

		return 2 if $name =~ /^Data/;
		return 1 if $name =~ /^Nod/;
		return 0;

	};

	return bless (\%options, $package);

}

sub parse {

	my ($self, $fn, $callback) = @_;

	open (F, $fn) or die "Can't read '$fn':$!\n";

	my $name;
	my @lines;
	my $attributes;
	my $collections;

	while (my $line = ) {

		$line =~ s{[\n\r]}{}gsm;

		if ($line =~ /^\[END/) {

			&$callback ({
				name  => $name,
				lines => \@lines,
				attributes => $attributes,
				collections => $collections,
			});

			undef $name;
			undef @lines;
			undef $attributes;
			undef $collections;

		}
		elsif ($line =~ /^\[([\w\s]+)\]$/) {

			$name = $1;

			next;

		}
		elsif (!$name) {

			next;

		}
		else {

			push @lines, $line;

			my ($key, $value) = split /\=/, $line;

			my $split_depth = &{$self -> {get_split_depth}} ($key);

			if ($split_depth == 1) {

				$value = [split /\,/, $value];

			}
			elsif ($split_depth == 2) {

				$value =~ s{^\(}{};
				$value =~ s{\)$}{};
				$value = [map {[split /\,/, $_]} split /\)\,\(/, $value];

			}

			$attributes -> {$key} = $value;

			if ($key =~ /([A-Za-z_]+)(\d+)$/) {
				$collections -> {$1} ||= [];
				$collections -> {$1} -> [$2] = $value;
			}

		}

	}

	close (F);

}

1;
__END__