File Coverage

blib/lib/EntityModel/Definition/XML.pm

Criterion	Covered	Total	%
statement	4	6	66.6
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	6	8	75.0

package EntityModel::Definition::XML;
{
  $EntityModel::Definition::XML::VERSION = '0.102';
}
use EntityModel::Class {
	_isa		=> [qw{EntityModel::Definition}],
};

=head1 NAME

EntityModel::Definition::XML - definition support for L

=head1 VERSION

version 0.102

=head1 SYNOPSIS

See L.

=head1 DESCRIPTION

See L.

=head1 METHODS

=cut

use XML::XPath;
use XML::XPath::Node;

=head2 load_file

=cut

sub load_file {
	my $self = shift;
	my $path = shift;

	my $xml = XML::XPath->new(filename => $path)
	 or die 'Unable to load ' . $self . ' from data source ' . $path;
	return $self->parse($xml);
}

=head2 load_string

=cut

sub load_string {
	my $self = shift;
	my $string = shift;

	my $xml = XML::XPath->new(xml => $string)
	 or die 'Unable to load ' . $self . ' from data source ' . $string;
	return $self->parse($xml);
}

=head2 parse

Parse the L object.

=cut

sub parse {
	my $self = shift;
	my $xml = shift;
	my $ns = $xml->find('/entitymodel') // [];
	my ($structure) = map { $self->parseNode($_) } @$ns;
	return $structure;
}

=head2 parseNode

Parse an individual node in the tree.

=cut

sub parseNode {
	my $self = shift;
	my $node = shift;
	my $name = $node->getName;

# Locate all child nodes (eliminating whitespace and other text nodes)
	my @child = grep { $_->getName } $node->getChildNodes;

	my %name;
	foreach my $c (@child) {
		my $grandchildCount = scalar(grep { $_->getName } $c->getChildNodes);
		if($grandchildCount) {
			push @{$name{$c->getName}}, $self->parseNode($c);
		} else {
			$name{$c->getName} = $c->string_value;
		}
	}
	return \%name;
}

1;

__END__