File Coverage

/root/.cpan/build/XML-BindData-0.3.2-0/blib/lib/XML/BindData.pm

Criterion	Covered	Total	%
statement	63	64	98.4
branch	27	30	90.0
condition	12	15	80.0
subroutine	7	7	100.0
pod	1	2	50.0
total	110	118	93.2

use strict;
use warnings;

package XML::BindData;
$XML::BindData::VERSION = '0.3.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) {
			my $value = _get( $context, $_->[1] );
			$node->setAttribute( $_->[0], $value ) if defined $value;
		}
	}

        if ( my $attr_defaults = _strip_attr( $node, 'tmpl-attr-defaults' ) ) {
            my @attributes
                = map {
                [   map { s/\\([:,])/$1/g; $_ } # remove backslash escaping
                    split qr/(?
                ]
                }
                split qr/(?
                $attr_defaults;

            foreach (@attributes) {
                my $value = $node->getAttribute( $_->[0] );
                $node->setAttribute( $_->[0], $_->[1] )
                    if ! defined $value || $value eq '';
            }
        }

	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__