File Coverage

blib/lib/XML/BindData.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

use strict;
use warnings;

package XML::BindData;
$XML::BindData::VERSION = '0.2';
use XML::LibXML;

sub bind {
	my ($class, $xml_string, $data) = @_;

	my $xml = XML::LibXML->load_xml(string => $xml_string);
	parse_node($xml->documentElement, $data);

	return $xml->toStringC14N(1);
}

sub parse_node {
	my ($node, $context) = @_;

	if (my $if_key = _strip_attr($node, 'tmpl-if')) {
		my $unless = $if_key =~ s/^!//;
		my $val    = _get($context, $if_key);
		if ( (!$unless && ! defined $val)
			|| ( $unless &&  defined $val)) {
			$node->unbindNode;
		}
	}

	if (my $each_key = _strip_attr($node, 'tmpl-each')) {
		my $parent = $node->parentNode;

		my $to_add = _get($context, $each_key);
		if (!$to_add || ref $to_add ne 'ARRAY') {
			$to_add = [];
		}

		foreach my $subcontext ( reverse @$to_add ) {
			my $new = $node->cloneNode(1); # deep clone
			parse_node($new, $subcontext);
			$parent->insertAfter( $new, $node );
		}
		$node->unbindNode;
		return;
	}

	if (my $binding = _strip_attr($node, 'tmpl-bind')) {
		my $val = _get($context, $binding);

        my $default = _strip_attr($node, 'tmpl-default');

        unless (defined $val) {
            $val = defined $default ? $default : '';
        }

		$node->appendTextNode($val);
	}

	if (my $attr_map = _strip_attr($node, 'tmpl-attr-map')) {
		my @attributes = map { [ split qr/:/ ] } split qr/,/, $attr_map;

		foreach (@attributes) {
			$node->setAttribute($_->[0], _get($context, $_->[1]));
		}
	}

        if ( my $attr_defaults = _strip_attr( $node, 'tmpl-attr-defaults' ) ) {
            my @attributes = map { [ split qr/:/ ] } split qr/,/,
                $attr_defaults;

            foreach (@attributes) {
                $node->setAttribute( $_->[0], $_->[1] )
                    unless defined $node->getAttribute( $_->[0] );
            }
        }

	my @children = grep {
		$_->nodeType eq XML_ELEMENT_NODE
	} $node->childNodes;
	parse_node($_, $context) foreach @children;
}

sub _get {
	my ($context, $key) = @_;

	return '' if !defined $key;

	return $context if $key eq 'this';

	my @parts = split qr/\./, $key;
	foreach (@parts) {
		$context = $context->{$_};
	}
	return $context;
}

sub _strip_attr {
	my ($node, $attr_name) = @_;

	if (my $attributes = $node->attributes) {
		if (my $attr = $attributes->removeNamedItem($attr_name)) {
			return $attr->nodeValue;
		}
	}
}

1;

__END__