#! /usr/bin/perl
use XML::DOM;
use XML::Parser;
use XML::NamespaceSupport;
use Scalar::Util;
package XML::Template;

sub process_file {
	my ($filename, $obj, $clean) = @_;

	my $parser = XML::DOM::Parser->new;
	my $doc = $parser->parsefile($filename);

	process($doc, $obj, $clean);

	return $doc;
}

sub process {
	my ($node, $obj, $clean, $nsup) = @_;
	$clean = 1 unless (defined($clean));

	if (!defined($nsup)) {
		$nsup = XML::NamespaceSupport->new;
	}

	if (!ref($obj)) {                                                       # overwrite
		for my $child ($node->getChildNodes) {
			$node->removeChild($child);
		}
		$node->addText($obj);
	} elsif (Scalar::Util::blessed($obj) && $obj->isa('XML::DOM::Node')) {  # overwrite
		for my $child ($node->getChildNodes) {
			$node->removeChild($child);
		}

		if ($obj->isa('XML::DOM::Document')) {
			$obj = $obj->getDocumentElement;
		}

		my $newobj = $obj->cloneNode(1);
		if ($node->isa('XML::DOM::Document')) {
			$newobj->setOwnerDocument($node);
		} else {
			$newobj->setOwnerDocument($node->getOwnerDocument);
		}
		$node->appendChild($newobj);

		process($newobj, {}, $clean, $nsup);
	} elsif (ref($obj) eq 'HASH') {                                         # substitute
		for my $child ($node->getChildNodes) {
			my $processed = 0;
			$nsup->push_context;

			if ($child->getNodeType == XML::DOM::ELEMENT_NODE) {
				# see if this node contains any namespace declarations that are relevant
				# for us
				my $attrs = $child->getAttributes;
				if (defined($attrs)) {
					for my $attr ($attrs->getValues) {
						my $name = $attr->getName;
						if ($name =~ /^xmlns:(.*)$/) {
							$nsup->declare_prefix($1, $attr->getValue);
							$child->removeAttribute($name) if ($clean);
						}
					}
				}

				my (undef, undef, $tag) = $nsup->process_element_name($child->getTagName);

				my $id;
				my $attrs = $child->getAttributes;
				if (defined($attrs)) {
					for my $attr ($attrs->getValues) {
						next if ($attr->getName =~ /^xmlns(:|$)/);

						my ($nsuri, undef, $tag) = $nsup->process_attribute_name($attr->getName);
						if ($nsuri eq 'http://template.sesse.net/' && $tag eq 'id') {
							$id = $attr->getValue;
							$child->removeAttribute($attr->getName) if ($clean);
						}
					}
				}

				# check all substitutions to see if we found anything
				# appropriate
				for my $key (keys %$obj) {
					if (($key =~ /^\Q$tag\E\/(.*)$/) ||
					    (defined($id) && $key =~ /^#\Q$id\E\/(.*)$/)) {
					    	$child->setAttribute($1, $obj->{$key});
					}

					next if ($processed);
					if ($key eq $tag || (defined($id) && $key eq ('#'.$id))) {
						process($child, $obj->{$key}, $clean, $nsup);
						$processed = 1;
					}
				}
			}

			process($child, $obj, $clean, $nsup) unless ($processed);
			$nsup->pop_context;
		}
	} elsif (ref($obj) eq 'ARRAY') {                                        # repeat
		my $doc = $node->getOwnerDocument;
		my $frag = $doc->createDocumentFragment;

		for my $child ($node->getChildNodes) {
			$frag->appendChild($child);
		}
		for my $child ($node->getChildNodes) {
			$node->removeChild($child);
		}
		
		for my $instance (@$obj) {

			my $newnode = $frag->cloneNode(1);
			process($newnode, $instance, $clean, $nsup);
			$node->appendChild($newnode);
			clean($newnode, $nsup) if ($clean);
		}

		$frag->dispose;
	}

	clean($node, $nsup) if $clean;
}

sub clean {
	my ($node, $nsup) = @_;

	if ($node->getNodeType == XML::DOM::ELEMENT_NODE) {
		my ($nsuri) = $nsup->process_element_name($node->getTagName);
		return unless ($nsuri eq 'http://template.sesse.net/');

		# as this is a dummy node, we want to remove it and move everything further up
		# after we've done any required replacements
		my $doc = $node->getOwnerDocument;
		my $frag = $doc->createDocumentFragment;

		for my $child ($node->getChildNodes) {
			$frag->appendChild($child);
		}
		for my $child ($node->getChildNodes) {
			$node->removeChild($child);
		}

		my $parent = $node->getParentNode;

		$parent->replaceChild($frag, $node);
	}
}

sub alternate {
	my ($tag, $array, @elems) = @_;

	my $i = 0;
	my $num = scalar @elems;

	for my $ref (@$array) {
		$ref->{$tag} = $elems[$i++ % $num];
	}

	return $array;
}

1;
