X-Git-Url: https://git.sesse.net/?a=blobdiff_plain;f=include%2FXML%2FTemplate.pm;fp=include%2FXML%2FTemplate.pm;h=3747f83b6340e8b2db95e48c6e8590226e90c1a4;hb=238f92e411b064cb85c1dee579b7dcaea5e99499;hp=0000000000000000000000000000000000000000;hpb=1fac0677bbcba5dec26e11aa661c97e38f6c3d40;p=wloh

diff --git a/include/XML/Template.pm b/include/XML/Template.pm
new file mode 100644
index 0000000..3747f83
--- /dev/null
+++ b/include/XML/Template.pm
@@ -0,0 +1,170 @@
+#! /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) {
+			next if (!defined($instance));
+
+			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) {
+		if (defined($ref)) {
+			$ref->{$tag} = $elems[$i++ % $num];
+		}
+	}
+
+	return $array;
+}
+
+1;