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;
28 # see if this node contains any namespace declarations that are relevant
30 my $attrs = $node->getAttributes;
31 if (defined($attrs)) {
32 for my $attr ($attrs->getValues) {
33 my $name = $attr->getName;
34 if ($name =~ /^xmlns:(.*)$/) {
35 $nsup->declare_prefix($1, $attr->getValue);
36 $node->removeAttribute($name) if ($clean);
41 if (!ref($obj)) { # overwrite
42 for my $child ($node->getChildNodes) {
43 $node->removeChild($child);
46 } elsif (Scalar::Util::blessed($obj) && $obj->isa('XML::DOM::Node')) { # overwrite
47 for my $child ($node->getChildNodes) {
48 $node->removeChild($child);
51 if ($obj->isa('XML::DOM::Document')) {
52 $obj = $obj->getDocumentElement;
55 my $newobj = $obj->cloneNode(1);
56 if ($node->isa('XML::DOM::Document')) {
57 $newobj->setOwnerDocument($node);
59 $newobj->setOwnerDocument($node->getOwnerDocument);
61 $node->appendChild($newobj);
62 } elsif (ref($obj) eq 'HASH') { # substitute
63 for my $child ($node->getChildNodes) {
66 if ($child->getNodeType == XML::DOM::ELEMENT_NODE) {
67 my (undef, undef, $tag) = $nsup->process_element_name($child->getTagName);
70 my $attrs = $child->getAttributes;
71 if (defined($attrs)) {
72 for my $attr ($attrs->getValues) {
73 next if ($attr->getName =~ /^xmlns(:|$)/);
75 my ($nsuri, undef, $tag) = $nsup->process_attribute_name($attr->getName);
76 if ($nsuri eq 'http://template.sesse.net/' && $tag eq 'id') {
77 $id = $attr->getValue;
78 $child->removeAttribute($attr->getName) if ($clean);
83 # check all substitutions to see if we found anything
85 for my $key (keys %$obj) {
86 if (($key =~ /^\Q$tag\E\.(.*)$/) ||
87 (defined($id) && $key =~ /^#\Q$id\E\.(.*)$/)) {
88 $child->setAttribute($1, $obj->{$key});
92 if ($key eq $tag || (defined($id) && $key =~ /^#\Q$id\E$/)) {
93 process($child, $obj->{$key}, $clean, $nsup);
99 process($child, $obj, $clean, $nsup) unless ($processed);
101 } elsif (ref($obj) eq 'ARRAY') { # repeat
102 my $doc = $node->getOwnerDocument;
103 my $frag = $doc->createDocumentFragment;
105 for my $child ($node->getChildNodes) {
106 $frag->appendChild($child);
108 for my $child ($node->getChildNodes) {
109 $node->removeChild($child);
112 for my $instance (@$obj) {
114 my $newnode = $frag->cloneNode(1);
115 process($newnode, $instance, $clean, $nsup);
116 $node->appendChild($newnode);
117 clean($newnode, $nsup) if ($clean);
125 clean($node, $nsup) if $clean;
130 my ($node, $nsup) = @_;
132 if ($node->getNodeType == XML::DOM::ELEMENT_NODE) {
133 my ($nsuri) = $nsup->process_element_name($node->getTagName);
134 return unless ($nsuri eq 'http://template.sesse.net/');
136 # as this is a dummy node, we want to remove it and move everything further up
137 # after we've done any required replacements
138 my $doc = $node->getOwnerDocument;
139 my $frag = $doc->createDocumentFragment;
141 for my $child ($node->getChildNodes) {
142 $frag->appendChild($child);
144 for my $child ($node->getChildNodes) {
145 $node->removeChild($child);
148 my $parent = $node->getParentNode;
150 $parent->replaceChild($frag, $node);
155 my ($tag, $array, @elems) = @_;
158 my $num = scalar @elems;
160 for my $ref (@$array) {
161 $ref->{$tag} = $elems[$i++ % $num];