4 use XML::NamespaceSupport;
9 my ($filename, $obj, $clean) = @_;
11 my $parser = XML::DOM::Parser->new;
12 my $doc = $parser->parsefile($filename);
14 process($doc, $obj, $clean);
20 my ($node, $obj, $clean, $nsup) = @_;
21 $clean = 1 unless (defined($clean));
23 if (!defined($nsup)) {
24 $nsup = XML::NamespaceSupport->new;
27 if (!ref($obj)) { # overwrite
28 for my $child ($node->getChildNodes) {
29 $node->removeChild($child);
32 } elsif (Scalar::Util::blessed($obj) && $obj->isa('XML::DOM::Node')) { # overwrite
33 for my $child ($node->getChildNodes) {
34 $node->removeChild($child);
37 if ($obj->isa('XML::DOM::Document')) {
38 $obj = $obj->getDocumentElement;
41 my $newobj = $obj->cloneNode(1);
42 if ($node->isa('XML::DOM::Document')) {
43 $newobj->setOwnerDocument($node);
45 $newobj->setOwnerDocument($node->getOwnerDocument);
47 $node->appendChild($newobj);
49 process($newobj, {}, $clean, $nsup);
50 } elsif (ref($obj) eq 'HASH') { # substitute
51 for my $child ($node->getChildNodes) {
55 if ($child->getNodeType == XML::DOM::ELEMENT_NODE) {
56 # see if this node contains any namespace declarations that are relevant
58 my $attrs = $child->getAttributes;
59 if (defined($attrs)) {
60 for my $attr ($attrs->getValues) {
61 my $name = $attr->getName;
62 if ($name =~ /^xmlns:(.*)$/) {
63 $nsup->declare_prefix($1, $attr->getValue);
64 $child->removeAttribute($name) if ($clean);
69 my (undef, undef, $tag) = $nsup->process_element_name($child->getTagName);
72 my $attrs = $child->getAttributes;
73 if (defined($attrs)) {
74 for my $attr ($attrs->getValues) {
75 next if ($attr->getName =~ /^xmlns(:|$)/);
77 my ($nsuri, undef, $tag) = $nsup->process_attribute_name($attr->getName);
78 if ($nsuri eq 'http://template.sesse.net/' && $tag eq 'id') {
79 $id = $attr->getValue;
80 $child->removeAttribute($attr->getName) if ($clean);
85 # check all substitutions to see if we found anything
87 for my $key (keys %$obj) {
88 if (($key =~ /^\Q$tag\E\/(.*)$/) ||
89 (defined($id) && $key =~ /^#\Q$id\E\/(.*)$/)) {
90 $child->setAttribute($1, $obj->{$key});
94 if ($key eq $tag || (defined($id) && $key eq ('#'.$id))) {
95 process($child, $obj->{$key}, $clean, $nsup);
101 process($child, $obj, $clean, $nsup) unless ($processed);
104 } elsif (ref($obj) eq 'ARRAY') { # repeat
105 my $doc = $node->getOwnerDocument;
106 my $frag = $doc->createDocumentFragment;
108 for my $child ($node->getChildNodes) {
109 $frag->appendChild($child);
111 for my $child ($node->getChildNodes) {
112 $node->removeChild($child);
115 for my $instance (@$obj) {
116 next if (!defined($instance));
118 my $newnode = $frag->cloneNode(1);
119 process($newnode, $instance, $clean, $nsup);
120 $node->appendChild($newnode);
121 clean($newnode, $nsup) if ($clean);
127 clean($node, $nsup) if $clean;
131 my ($node, $nsup) = @_;
133 if ($node->getNodeType == XML::DOM::ELEMENT_NODE) {
134 my ($nsuri) = $nsup->process_element_name($node->getTagName);
135 return unless ($nsuri eq 'http://template.sesse.net/');
137 # as this is a dummy node, we want to remove it and move everything further up
138 # after we've done any required replacements
139 my $doc = $node->getOwnerDocument;
140 my $frag = $doc->createDocumentFragment;
142 for my $child ($node->getChildNodes) {
143 $frag->appendChild($child);
145 for my $child ($node->getChildNodes) {
146 $node->removeChild($child);
149 my $parent = $node->getParentNode;
151 $parent->replaceChild($frag, $node);
156 my ($tag, $array, @elems) = @_;
159 my $num = scalar @elems;
161 for my $ref (@$array) {
163 $ref->{$tag} = $elems[$i++ % $num];