From fcbc80b8d39f95b1625298daa56caee62dfe980c Mon Sep 17 00:00:00 2001 From: Mike Taylor Date: Mon, 13 Nov 2006 18:03:34 +0000 Subject: [PATCH] New utiltiy find_or_make_node() finds a node within an XPathContext, or, if it doesn't yet exist, makes it within its parent and returns it. This calls itself recursively as necessary to make the parent, grandparent, etc., but catches deep recursion and dies (currently defined as ten levels which seems like plenty). dom_add_element() now uses this. --- lib/ZOOM/IRSpy/Utils.pm | 40 +++++++++++++++++++++++++++++----------- 1 file changed, 29 insertions(+), 11 deletions(-) diff --git a/lib/ZOOM/IRSpy/Utils.pm b/lib/ZOOM/IRSpy/Utils.pm index 8efcd7c..8ddbcab 100644 --- a/lib/ZOOM/IRSpy/Utils.pm +++ b/lib/ZOOM/IRSpy/Utils.pm @@ -1,4 +1,4 @@ -# $Id: Utils.pm,v 1.10 2006-11-13 16:47:57 mike Exp $ +# $Id: Utils.pm,v 1.11 2006-11-13 18:03:34 mike Exp $ package ZOOM::IRSpy::Utils; @@ -134,16 +134,8 @@ sub dom_add_element { my($xc, $ppath, $element, $value, @addAfter) = @_; #print "Adding $element='$value' at '$ppath' after (", join(", ", map { "'$_'" } @addAfter), ")
\n"; - my @nodes = $xc->findnodes($ppath); - if (@nodes == 0) { - # Oh dear, the parent node doesn't exist. We could make it, - # but for now let's not and say we did. - ### - warn "no parent node '$ppath': not adding '$element'='$value'"; - return; - } - warn scalar(@nodes), " nodes match parent '$ppath'" if @nodes > 1; - my $node = $nodes[0]; + my $node = find_or_make_node($xc, $ppath, 0); + return if !defined $node; ### should be a "can't happen" my(undef, $prefix, $nsElem) = $element =~ /((.*?):)?(.*)/; my $new = new XML::LibXML::Element($nsElem); @@ -181,6 +173,32 @@ sub dom_add_element { } +sub find_or_make_node { + my($xc, $path, $recursion_level) = @_; + + die "deep recursion in find_or_make_node($path)" + if $recursion_level == 10; + + my @nodes = $xc->findnodes($path); + if (@nodes == 0) { + # Oh dear, the parent node doesn't exist. We could make it, + my($ppath, $element) = $path =~ /(.*)\/(.*)/; + warn "no node '$path': making it"; + my $parent = find_or_make_node($xc, $ppath, $recursion_level-1); + + my(undef, $prefix, $nsElem) = $element =~ /((.*?):)?(.*)/; + my $new = new XML::LibXML::Element($nsElem); + $new->setNamespace(irspy_namespace($prefix), $prefix) + if $prefix ne ""; + + $parent->appendChild($new); + return $new; + } + warn scalar(@nodes), " nodes match parent '$path'" if @nodes > 1; + return $nodes[0]; +} + + sub inheritance_tree { my($type, $level) = @_; $level = 0 if !defined $level; -- 1.7.10.4