File Coverage

blib/lib/Data/Edit/Xml.pm

Criterion	Covered	Total	%
statement	15	17	88.2
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	21	23	91.3

line	stmt	sub	time	code
1				#!/usr/bin/perl #-I/home/phil/z/perl/cpan/DataTableText/lib
2				#-------------------------------------------------------------------------------
3				# Edit data held in xml format
4				# Philip R Brenan at gmail dot com, Appa Apps Ltd Inc, 2016-2017
5				#-------------------------------------------------------------------------------
6				# podDocumentation
7
8				package Data::Edit::Xml;
9				our $VERSION = 20170829;
10	1	1	1152	use v5.8.0;
	1		2
11	1	1	4	use warnings FATAL => qw(all);
	1		1
	1		26
12	1	1	4	use strict;
	1		1
	1		23
13	1	1	4	use Carp qw(cluck confess);
	1		1
	1		56
14	1	1	466	use Data::Table::Text qw(:all);
	1		35253
	1		309
15	1	1	723	use XML::Parser; # https://metacpan.org/pod/XML::Parser
	0
	0
16				use Storable qw(store retrieve freeze thaw);
17
18				#1 Construction # Create a parse tree, either by parsing a L, or, L, or, from another L'
19
20				#2 File or String # Construct a parse tree from a file or a string
21
22				sub new(;$) #IS New parse - call this method statically as in Data::Edit::Xml::new(file or string) B with no parameters and then use L, L, L, L to provide specific parameters for the parse, then call L to perform the parse and return the parse tree.
23				{my ($fileNameOrString) = @_; # File name or string
24				if (@_)
25				{my $x = bless {input=>$fileNameOrString}; # Create xml editor with a string or file
26				$x->parser = $x; # Parser root node
27				return $x->parse; # Parse
28				}
29				my $x = bless {}; # Create empty xml editor
30				$x->parser = $x; # Parser root node
31				$x # Parser
32				}
33
34				genLValueArrayMethods (qw(content)); # Content of command: the nodes immediately below this node in the order in which they appeared in the source text, see also L.
35				genLValueArrayMethods (qw(numbers)); # Nodes by number.
36				genLValueHashMethods (qw(attributes)); # The attributes of this node, see also: L. The frequently used attributes: class, id, href, outputclass can be accessed by an lvalue method as in: $node->id = 'c1'.
37				genLValueHashMethods (qw(conditions)); # Conditional strings attached to a node, see L.
38				genLValueHashMethods (qw(indexes)); # Indexes to sub commands by tag in the order in which they appeared in the source text.
39				genLValueHashMethods (qw(labels)); # The labels attached to a node to provide addressability from other nodes, see: L.
40				genLValueScalarMethods(qw(errorsFile)); # Error listing file. Use this parameter to explicitly set the name of the file that will be used to write an parse errors to. By default this file is named: B.
41				genLValueScalarMethods(qw(inputFile)); # Source file of the parse if this is the parser root node. Use this parameter to explicitly set the file to be parsed.
42				genLValueScalarMethods(qw(input)); # Source of the parse if this is the parser root node. Use this parameter to specify some input either as a string or as a file name for the parser to convert into a parse tree.
43				genLValueScalarMethods(qw(inputString)); # Source string of the parse if this is the parser root node. Use this parameter to explicitly set the string to be parsed.
44				genLValueScalarMethods(qw(number)); # Number of this node, see L.
45				genLValueScalarMethods(qw(numbering)); # Last number used to number a node in this parse tree.
46				genLValueScalarMethods(qw(parent)); # Parent node of this node or undef if the oarser root node. See also L and L. Consider as read only.
47				genLValueScalarMethods(qw(parser)); # Parser details: the root node of a tree is the parse node for that tree. Consider as read only.
48				genLValueScalarMethods(qw(tag)); # Tag name for this node, see also L and L. Consider as read only.
49				genLValueScalarMethods(qw(text)); # Text of this node but only if it is a text node, i.e. the tag is cdata() <=> L is true.
50
51				sub cdata() # The name of the tag to be used to represent text - this tag must not also be used as a command tag otherwise the parser will L.
52				{'CDATA'
53				}
54
55				sub parse($) # Parse input xml specified via: L, L or L.
56				{my ($parser) = @_; # Parser created by L
57				my $badFile = $parser->errorsFile // fullFileName('zzzParseErrors/out.data'); # File to write source xml into if a parsing error occurs
58				unlink $badFile if -e $badFile; # Remove existing errors file
59
60				if (my $s = $parser->input) # Source to be parsed is a file or a string
61				{if ($s =~ /\n/s or !-e $s) # Parse as a string because it does not look like a file name
62				{$parser->inputString = $s;
63				}
64				else # Parse a file
65				{$parser->inputFile = $s;
66				$parser->inputString = readFile($s);
67				}
68				}
69				elsif (my $f = $parser->inputFile) # Source to be parsed is a file
70				{$parser->inputString = readFile($f);
71				}
72				elsif ($parser->inputString) {} # Source to be parsed is a string
73				else # Unknown string
74				{confess "Supply a string or file to be parsed";
75				}
76
77				my $xmlParser = new XML::Parser(Style => 'Tree'); # Extend Larry Wall's excellent XML parser
78				my $d = $parser->inputString; # String to be parsed
79				my $x = eval {$xmlParser->parse($d)}; # Parse string
80				if (!$x) # Error in parse
81				{my $f = $parser->inputFile ? "Source files is:\n". # Source details if a file
82				$parser->inputFile."\n" : '';
83				writeFile($badFile, "$d\n$f\n$@\n"); # Write a description of the error to the errorsFile
84				confess "Xml parse error, see file:\n$badFile\n"; # Complain helpfully if parse failed
85				}
86				$parser->tree($x); # Structure parse results as a tree
87				if (my @c = @{$parser->content})
88				{confess "No xml" if !@c;
89				confess "More than one outer-most tag" if @c > 1;
90				my $c = $c[0];
91				$parser->tag = $c->tag;
92				$parser->attributes = $c->attributes;
93				$parser->content = $c->content;
94				$parser->parent = undef;
95				$parser->indexNode;
96				}
97				$parser # Parse details
98				}
99
100				sub tree($$) #P Build a tree representation of the parsed xml which can be easily traversed to look for things.
101				{my ($parent, $parse) = @_; # The parent node, the remaining parse
102				while(@$parse)
103				{my $tag = shift @$parse; # Tag for node
104				my $node = bless {parser=>$parent->parser}; # New node
105				if ($tag eq cdata)
106				{confess cdata.' tag encountered'; # We use this tag for text and so it cannot be used as a user tag in the document
107				}
108				elsif ($tag eq '0') # Text
109				{my $s = shift @$parse;
110				if ($s !~ /\A\s*\Z/) # Ignore entirely blank strings
111				{$s = replaceSpecialChars($s); # Restore special characters in the text
112				$node->tag = cdata; # Save text. ASSUMPTION: CDATA is not used as a tag anywhere.
113				$node->text = $s;
114				push @{$parent->content}, $node; # Save on parents content list
115				}
116				}
117				else # Node
118				{my $children = shift @$parse;
119				my $attributes = shift @$children;
120				$node->tag = $tag; # Save tag
121				$_ = replaceSpecialChars($_) for values %$attributes; # Restore in text with xml special characters
122				$node->attributes = $attributes; # Save attributes
123				push @{$parent->content}, $node; # Save on parents content list
124				$node->tree($children) if $children; # Add nodes below this node
125				}
126				}
127				$parent->indexNode; # Index this node
128				}
129
130				#2 Node by Node # Construct a parse tree node by node.
131
132				sub newText($$) # Create a new text node.
133				{my (undef, $text) = @_; # Any reference to this package, content of new text node
134				my $node = bless {}; # New node
135				$node->parser = $node; # Root node of this parse
136				$node->tag = cdata; # Text node
137				$node->text = $text; # Content of node
138				$node # Return new non text node
139				}
140
141				sub newTag($$%) # Create a new non text node.
142				{my (undef, $command, %attributes) = @_; # Any reference to this package, the tag for the node, attributes as a hash.
143				my $node = bless {}; # New node
144				$node->parser = $node; # Root node of this parse
145				$node->tag = $command; # Tag for node
146				$node->attributes = \%attributes; # Attributes for node
147				$node # Return new node
148				}
149
150				sub newTree($%) # Create a new tree.
151				{my ($command, %attributes) = @_; # The name of the root node in the tree, attributes of the root node in the tree as a hash.
152				&newTag(undef, @_)
153				}
154
155				sub disconnectLeafNode($) #P Remove a leaf node from the parse tree and make it into its own parse tree.
156				{my ($node) = @_; # Leaf node to disconnect.
157				$node->parent = undef; # No parent
158				$node->parser = $node; # Own parse tree
159				}
160
161				sub indexNode($) #P Index the children of a node so that we can access them by tag and number.
162				{my ($node) = @_; # Node to index.
163				delete $node->{indexes}; # Delete the indexes
164				my @contents = $node->contents; # Contents of the node
165				return unless @contents; # No content so no indexes
166
167				if ((grep {$_->isText} @contents) > 1) # Make parsing easier for the user by concatenating successive text nodes
168				{my (@c, @t); # New content, pending intermediate texts list
169				for(@contents) # Each node under the current node
170				{if ($_->isText) # Text node
171				{push @t, $_; # Add the text node to pending intermediate texts list
172				}
173				elsif (@t == 1) # Non text element encountered with one pending intermediate text
174				{push @c, @t, $_; # Save the text node and the latest non text node
175				@t = (); # Empty pending intermediate texts list
176				}
177				elsif (@t > 1) # Non text element encountered with two or more pending intermediate texts
178				{my $t = shift @t; # Reuse the first text node
179				$t->text .= join '', map {$_->text} @t; # Concatenate the remaining text nodes
180				$_->disconnectLeafNode for @t; # Disconnect the remain text nodes as they are no longer needed
181				push @c, $t, $_; # Save the resulting text node and the latest non text node
182				@t = (); # Empty pending intermediate texts list
183				}
184				else {push @c, $_} # Non text node encountered without immediately preceding text
185				}
186
187				if (@t == 0) {} # No action required if no pending text at the end
188				elsif (@t == 1) {push @c, @t} # Just one text node
189				else # More than one text node - remove leading and trailing blank text nodes
190				{my $t = shift @t; # Reuse the first text node
191				$t->text .= join '', map {$_->text} @t; # Concatenate the remaining text nodes
192				$_->disconnectLeafNode for @t; # Disconnect the remain text nodes as they are no longer needed
193				push @c, $t; # Save resulting text element
194				}
195
196				@contents = @c; # The latest content of the node
197				$node->content = \@c; # Node contents with concatenated text elements
198				}
199
200				for my $n(@contents) # Index content
201				{push @{$node->indexes->{$n->tag}}, $n; # Indices to sub nodes
202				$n->parent = $node; # Point to parent
203				$n->parser = $node->parser; # Point to parser
204				}
205				}
206
207				sub replaceSpecialChars($) # Replace < > " with < > " Larry Wall's excellent L unfortunately replaces < > " & etc. with their expansions in text by default and does not seem to provide an obvious way to stop this behavior, so we have to put them back gain using this method. Worse, we cannot decide whether to replace & with & or leave it as is: consequently you might have to examine the instances of & in your output text and guess based on the context.
208				{my ($string) = @_; # String to be edited.
209				$_[0] =~ s/\/>/gr =~ s/\"/"/gr # Replace the special characters that we can replace.
210				}
211
212				#2 Parse tree # Construct a parse tree from another parse tree
213
214				sub renew($) # Returns a renewed copy of the parse tree: use this method if you have added nodes via the L methods and wish to add them to the parse tree
215				{my ($node) = @_; # Parse tree.
216				new($node->string)
217				}
218
219				sub clone($) # Return a clone of the parse tree: the parse tree is cloned without converting it to string and reparsing it so this method will not L any nodes added L.
220				{my ($node) = @_; # Parse tree.
221				my $f = freeze($node);
222				my $t = thaw($f);
223				$t->parent = undef;
224				$t->parser = $t;
225				$t
226				}
227
228				sub equals($$) #X Return the first node if the two parse trees are equal, else B if they are not equal.
229				{my ($node1, $node2) = @_; # Parse tree 1, parse tree 2.
230				$node1->string eq $node2->string ? $node1 : undef # Test
231				}
232
233				sub save($$) # Save a copy of the parse tree to a file which can be L and return the saved node.
234				{my ($node, $file) = @_; # Parse tree, file.
235				makePath($file);
236				store $node, $file;
237				$node
238				}
239
240				sub restore($) #SX Return a parse tree from a copy saved in a file by L.
241				{my ($file) = @_; # File
242				-e $file or confess "Cannot restore from a non existent file:\n$file";
243				retrieve $file
244				}
245
246				#1 Print # Create a string representation of the parse tree with optional selection of nodes via L.\mNormally use the methods in L to format the xml in a readable yet reparseable manner; use L string to format the xml densely in a reparseable manner; use the other methods to produce unreparseable strings conveniently formatted to assist various specialized operations such as debugging CDATA, using labels or creating tests. A number of the L can also be conveniently used to print parse trees in these formats.
247
248				#2 Pretty # Pretty print the parse tree.
249
250				sub prettyString($;$) #I Return a readable string representing a node of a parse tree and all the nodes below it. Or use L<-p\|/opString> $node
251				{my ($node, $depth) = @_; # Start node, optional depth.
252				$depth //= 0; # Start depth if none supplied
253
254				if ($node->isText) # Text node
255				{my $n = $node->next;
256				my $s = !defined($n) \|\| $n->isText ? '' : "\n"; # Add a new line after contiguous blocks of text to offset next node
257				return $node->text.$s;
258				}
259
260				my $t = $node->tag; # Not text so it has a tag
261				my $content = $node->content; # Sub nodes
262				my $space = " "x($depth//0);
263				return $space.'<'.$t.$node->printAttributes.'/>'."\n" if !@$content; # No sub nodes
264
265				my $s = $space.'<'.$t.$node->printAttributes.'>'. # Has sub nodes
266				($node->first->isText ? '' : "\n"); # Continue text on the same line, otherwise place nodes on following lines
267				$s .= $_->prettyString($depth+1) for @$content; # Recurse to get the sub content
268				$s .= $node->last->isText ? ((grep{!$_->isText} @$content) # Continue text on the same line, otherwise place nodes on following lines
269				? "\n$space": "") : $space;
270				$s . ''."\n"; # Closing tag
271				}
272
273				sub prettyStringNumbered($;$) # Return a readable string representing a node of a parse tree and all the nodes below it with a L attached to each tag. The node numbers can then be used as described in L to monitor changes to the parse tree.
274				{my ($node, $depth) = @_; # Start node, optional depth.
275				$depth //= 0; # Start depth if none supplied
276
277				my $N = $node->number; # Node number if present
278
279				if ($node->isText) # Text node
280				{my $n = $node->next;
281				my $s = !defined($n) \|\| $n->isText ? '' : "\n"; # Add a new line after contiguous blocks of text to offset next node
282				return ($N ? "($N)" : '').$node->text.$s; # Number text
283				}
284
285				my $t = $node->tag; # Number tag in a way which allows us to skip between start and end tags in L using the ctrl+up and ctrl+down arrows
286				my $i = $N ? " id=\"$N\"" : ''; # Use id to hold tag
287				my $content = $node->content; # Sub nodes
288				my $space = " "x($depth//0);
289				return $space.'<'.$t.$i.$node->printAttributes.'/>'."\n" if !@$content; # No sub nodes
290
291				my $s = $space.'<'.$t.$i.$node->printAttributes.'>'. # Has sub nodes
292				($node->first->isText ? '' : "\n"); # Continue text on the same line, otherwise place nodes on following lines
293				$s .= $_->prettyStringNumbered($depth+1) for @$content; # Recurse to get the sub content
294				$s .= $node->last->isText ? ((grep{!$_->isText} @$content) # Continue text on the same line, otherwise place nodes on following lines
295				? "\n$space": "") : $space;
296				$s . ''."\n"; # Closing tag
297				}
298
299				sub prettyStringCDATA($;$) # Return a readable string representing a node of a parse tree and all the nodes below it with the text fields wrapped with ....
300				{my ($node, $depth) = @_; # Start node, optional depth.
301				$depth //= 0; # Start depth if none supplied
302
303				if ($node->isText) # Text node
304				{my $n = $node->next;
305				my $s = !defined($n) \|\| $n->isText ? '' : "\n"; # Add a new line after contiguous blocks of text to offset next node
306				return '<'.cdata.'>'.$node->text.''.$s;
307				}
308
309				my $t = $node->tag; # Not text so it has a tag
310				my $content = $node->content; # Sub nodes
311				my $space = " "x($depth//0);
312				return $space.'<'.$t.$node->printAttributes.'/>'."\n" if !@$content; # No sub nodes
313
314				my $s = $space.'<'.$t.$node->printAttributes.'>'. # Has sub nodes
315				($node->first->isText ? '' : "\n"); # Continue text on the same line, otherwise place nodes on following lines
316				$s .= $_->prettyStringCDATA($depth+2) for @$content; # Recurse to get the sub content
317				$s .= $node->last->isText ? ((grep{!$_->isText} @$content) # Continue text on the same line, otherwise place nodes on following lines
318				? "\n$space": "") : $space;
319				$s . ''."\n"; # Closing tag
320				}
321
322				sub prettyStringEnd($) #P Return a readable string representing a node of a parse tree and all the nodes below it as a here document
323				{my ($node) = @_; # Start node
324				my $s = -p $node; # Pretty string representation
325				' ok -p $x eq <
326				}
327
328				sub prettyStringContent($) # Return a readable string representing all the nodes below a node of a parse tree - infrequent use and so capitalized to avoid being presented as an option by L.
329				{my ($node) = @_; # Start node.
330				my $s = '';
331				$s .= $_->prettyString for $node->contents; # Recurse to get the sub content
332				$s
333				}
334
335				#2 Dense # Print the parse tree.
336
337				sub string($) # Return a dense string representing a node of a parse tree and all the nodes below it. Or use L<-s\|/opString> $node
338				{my ($node) = @_; # Start node.
339				return $node->text if $node->isText; # Text node
340				my $t = $node->tag; # Not text so it has a tag
341				my $content = $node->content; # Sub nodes
342				return '<'.$t.$node->printAttributes.'/>' if !@$content; # No sub nodes
343
344				my $s = '<'.$t.$node->printAttributes.'>'; # Has sub nodes
345				$s .= $_->string for @$content; # Recurse to get the sub content
346				return $s.'';
347				}
348
349				sub stringQuoted($) # Return a quoted string representing a parse tree a node of a parse tree and all the nodes below it. Or use L<-o\|/opString> $node
350				{my ($node) = @_; # Start node
351				"'".$node->string."'"
352				}
353
354				sub stringReplacingIdsWithLabels($) # Return a string representing the specified parse tree with the id attribute of each node set to the L attached to each node.
355				{my ($node) = @_; # Start node.
356				return $node->text if $node->isText; # Text node
357				my $t = $node->tag; # Not text so it has a tag
358				my $content = $node->content; # Sub nodes
359				return '<'.$t.$node->printAttributesReplacingIdsWithLabels.'/>' if !@$content;# No sub nodes
360
361				my $s = '<'.$t.$node->printAttributesReplacingIdsWithLabels.'>'; # Has sub nodes
362				$s .= $_->stringReplacingIdsWithLabels for @$content; # Recurse to get the sub content
363				return $s.'';
364				}
365
366				sub stringContent($) # Return a string representing all the nodes below a node of a parse tree.
367				{my ($node) = @_; # Start node.
368				my $s = '';
369				$s .= $_->string for $node->contents; # Recurse to get the sub content
370				$s
371				}
372
373				sub stringNode($) # Return a string representing a node showing the attributes, labels and node number
374				{my ($node) = @_; # Node.
375				my $s = '';
376
377				if ($node->isText) # Text node
378				{$s = 'CDATA='.$node->text;
379				}
380				else # Non text node
381				{$s = $node->tag.$node->printAttributes;
382				}
383
384				if (my $n = $node->number) # Node number if present
385				{$s .= "($n)"
386				}
387
388				if (my @l = $node->getLabels) # Labels
389				{$s .= " ${_}:".$l[$_] for keys @l;
390				}
391
392				$s
393				}
394
395				#2 Conditions # Print a subset of the the parse tree determined by the conditions attached to it.
396
397				sub stringWithConditions($@) # Return a string representing a node of a parse tree and all the nodes below it subject to conditions to select or reject some nodes.
398				{my ($node, @conditions) = @_; # Start node, conditions to be regarded as in effect.
399				return $node->text if $node->isText; # Text node
400				my %c = %{$node->conditions}; # Process conditions if any for this node
401				return '' if keys %c and @conditions and !grep {$c{$_}} @conditions; # Return if conditions are in effect and no conditions match
402				my $t = $node->tag; # Not text so it has a tag
403				my $content = $node->content; # Sub nodes
404
405				my $s = ''; $s .= $_->stringWithConditions(@conditions) for @$content; # Recurse to get the sub content
406				return '<'.$t.$node->printAttributes.'/>' if !@$content or $s =~ /\A\s*\Z/; # No sub nodes or none selected
407				'<'.$t.$node->printAttributes.'>'.$s.''; # Has sub nodes
408				}
409
410				sub addConditions($@) # Add conditions to a node and return the node.
411				{my ($node, @conditions) = @_; # Node, conditions to add.
412				$node->conditions->{$_}++ for @conditions;
413				$node
414				}
415
416				sub deleteConditions($@) # Delete conditions applied to a node and return the node.
417				{my ($node, @conditions) = @_; # Node, conditions to add.
418				delete $node->conditions->{$_} for @conditions;
419				$node
420				}
421
422				sub listConditions($) # Return a list of conditions applied to a node.
423				{my ($node) = @_; # Node.
424				sort keys %{$node->conditions}
425				}
426
427				#1 Attributes # Get or set the attributes of nodes in the parse tree. Well known attributes can be set directly via L B_{s for less well known attributes use L.}
428
429				if (0) { # Node attributes.
430				genLValueScalarMethods(qw(class)); # Attribute B for a node as an L B_.
431				genLValueScalarMethods(qw(href)); # Attribute B for a node as an L B_.
432				genLValueScalarMethods(qw(id)); # Attribute B for a node as an L B_.
433				genLValueScalarMethods(qw(outputclass)); # Attribute B for a node as an L B_.
434				}
435
436				BEGIN
437				{for(qw(class href id outputclass)) # Return well known attributes as an assignable value
438				{eval 'sub '.$_.'($) :lvalue {&attr($_[0], qw('.$_.'))}';
439				$@ and confess "Cannot create well known attribute $_\n$@";
440				}
441				}
442
443				sub attr($$) :lvalue #I Return the value of an attribute of the current node as an L B_.
444				{my ($node, $attribute) = @_; # Node in parse tree, attribute name.
445				$node->attributes->{$attribute}
446				}
447
448				sub attrs($@) # Return the values of the specified attributes of the current node.
449				{my ($node, @attributes) = @_; # Node in parse tree, attribute names.
450				my @v;
451				my $a = $node->attributes;
452				push @v, $a->{$_} for @attributes;
453				@v
454				}
455
456				sub attrCount($) # Return the number of attributes in the specified node.
457				{my ($node) = @_; # Node in parse tree, attribute names.
458				keys %{$node->attributes}
459				}
460
461				sub getAttrs($) # Return a sorted list of all the attributes on this node.
462				{my ($node) = @_; # Node in parse tree.
463				sort keys %{$node->attributes}
464				}
465
466				sub setAttr($@) # Set the values of some attributes in a node and return the node.
467				{my ($node, %values) = @_; # Node in parse tree, (attribute name=>new value)*
468				s/["<>]/ /gs for grep {$_} values %values; # We cannot have these characters in an attribute
469				$node->attributes->{$_} = $values{$_} for keys %values; # Set attributes
470				$node
471				}
472
473				sub deleteAttr($$;$) # Delete the attribute, optionally checking its value first and return the node.
474				{my ($node, $attr, $value) = @_; # Node, attribute name, optional attribute value to check first.
475				my $a = $node->attributes; # Attributes hash
476				if (@_ == 3)
477				{delete $a->{$attr} if defined($a->{$attr}) and $a->{$attr} eq $value; # Delete user key if it has the right value
478				}
479				else
480				{delete $a->{$attr}; # Delete user key unconditionally
481				}
482				$node
483				}
484
485				sub deleteAttrs($@) # Delete any attributes mentioned in a list without checking their values and return the node.
486				{my ($node, @attrs) = @_; # Node, attribute name, optional attribute value to check first.
487				my $a = $node->attributes; # Attributes hash
488				delete $a->{$_} for @attrs;
489				$node
490				}
491
492				sub renameAttr($$$) # Change the name of an attribute regardless of whether the new attribute already exists and return the node.
493				{my ($node, $old, $new) = @_; # Node, existing attribute name, new attribute name.
494				my $a = $node->attributes; # Attributes hash
495				if (defined($a->{$old})) # Check old attribute exists
496				{my $value = $a->{$old}; # Existing value
497				$a->{$new} = $value; # Change the attribute name
498				delete $a->{$old};
499				}
500				$node
501				}
502
503				sub changeAttr($$$) # Change the name of an attribute unless it has already been set and return the node.
504				{my ($node, $old, $new) = @_; # Node, existing attribute name, new attribute name.
505				exists $node->attributes->{$new} ? $node : $node->renameAttr($old, $new) # Check old attribute exists
506				}
507
508				sub renameAttrValue($$$$$) # Change the name and value of an attribute regardless of whether the new attribute already exists and return the node.
509				{my ($node, $old, $oldValue, $new, $newValue) = @_; # Node, existing attribute name, existing attribute value, new attribute name, new attribute value.
510				my $a = $node->attributes; # Attributes hash
511				if (defined($a->{$old}) and $a->{$old} eq $oldValue) # Check old attribute exists and has the specified value
512				{$a->{$new} = $newValue; # Change the attribute name
513				delete $a->{$old};
514				}
515				$node
516				}
517
518				sub changeAttrValue($$$$$) # Change the name and value of an attribute unless it has already been set and return the node.
519				{my ($node, $old, $oldValue, $new, $newValue) = @_; # Node, existing attribute name, existing attribute value, new attribute name, new attribute value.
520				exists $node->attributes->{$new} ? $node : # Check old attribute exists
521				$node->renameAttrValue($old, $oldValue, $new, $newValue)
522				}
523
524				#1 Traversal # Traverse the parse tree in various orders applying a B_{to each node.}
525
526				#2 Post-order # This order allows you to edit children before their parents
527
528				sub by($$;@) #I Post-order traversal of a parse tree or sub tree calling the specified B_{at each node and returning the specified starting node. The B_{is passed references to the current node and all of its L. The value of the current node is also made available via B<$_>.}}
529				{my ($node, $sub, @context) = @_; # Starting node, sub to call for each sub node, accumulated context.
530				my @n = $node->contents; # Clone the content array so that the tree can be modified if desired
531				$_->by($sub, $node, @context) for @n; # Recurse to process sub nodes in deeper context
532				&$sub(local $_ = $node, @context); # Process specified node last
533				$node
534				}
535
536				sub byX($$;@) # Post-order traversal of a parse tree or sub tree calling the specified B_{within LB<{}> at each node and returning the specified starting node. The B_{is passed references to the current node and all of its L. The value of the current node is also made available via B<$_>.}}
537				{my ($node, $sub, @context) = @_; # Starting node, sub to call, accumulated context.
538				my @n = $node->contents; # Clone the content array so that the tree can be modified if desired
539				$_->byX($sub, $node, @context) for @n; # Recurse to process sub nodes in deeper context
540				eval {&$sub(local $_ = $node, @context)}; # Process specified node last
541				$node
542				}
543
544				sub byReverse($$;@) # Reverse post-order traversal of a parse tree or sub tree calling the specified B_{at each node and returning the specified starting node. The B_{is passed references to the current node and all of its L. The value of the current node is also made available via B<$_>.}}
545				{my ($node, $sub, @context) = @_; # Starting node, sub to call for each sub node, accumulated context.
546				my @n = $node->contents; # Clone the content array so that the tree can be modified if desired
547				$_->byReverse($sub, $node, @context) for reverse @n; # Recurse to process sub nodes in deeper context
548				&$sub(local $_ = $node, @context); # Process specified node last
549				$node
550				}
551
552				sub byReverseX($$;@) # Reverse post-order traversal of a parse tree or sub tree calling the specified B_{within LB<{}> at each node and returning the specified starting node. The B_{is passed references to the current node and all of its L. The value of the current node is also made available via B<$_>.}}
553				{my ($node, $sub, @context) = @_; # Starting node, sub to call for each sub node, accumulated context.
554				my @n = $node->contents; # Clone the content array so that the tree can be modified if desired
555				$_->byReverseX($sub, $node, @context) for reverse @n; # Recurse to process sub nodes in deeper context
556				&$sub(local $_ = $node, @context); # Process specified node last
557				$node
558				}
559
560				#2 Pre-order # This order allows you to edit children after their parents
561
562				sub down($$;@) # Pre-order traversal down through a parse tree or sub tree calling the specified B_{at each node and returning the specified starting node. The B_{is passed references to the current node and all of its L. The value of the current node is also made available via B<$_>.}}
563				{my ($node, $sub, @context) = @_; # Starting node, sub to call for each sub node, accumulated context.
564				my @n = $node->contents; # Clone the content array so that the tree can be modified if desired
565				&$sub(local $_ = $node, @context); # Process specified node first
566				$_->down($sub, $node, @context) for @n; # Recurse to process sub nodes in deeper context
567				$node
568				}
569
570				sub downX($$;@) # Pre-order traversal down through a parse tree or sub tree calling the specified B_{within LB<{}> at each node and returning the specified starting node. The B_{is passed references to the current node and all of its L. The value of the current node is also made available via B<$_>.}}
571				{my ($node, $sub, @context) = @_; # Starting node, sub to call for each sub node, accumulated context.
572				my @n = $node->contents; # Clone the content array so that the tree can be modified if desired
573				&$sub(local $_ = $node, @context); # Process specified node first
574				$_->downX($sub, $node, @context) for @n; # Recurse to process sub nodes in deeper context
575				$node
576				}
577
578				sub downReverse($$;@) # Reverse pre-order traversal down through a parse tree or sub tree calling the specified B_{at each node and returning the specified starting node. The B_{is passed references to the current node and all of its L. The value of the current node is also made available via B<$_>.}}
579				{my ($node, $sub, @context) = @_; # Starting node, sub to call for each sub node, accumulated context.
580				my @n = $node->contents; # Clone the content array so that the tree can be modified if desired
581				&$sub(local $_ = $node, @context); # Process specified node first
582				$_->downReverse($sub, $node, @context) for reverse @n; # Recurse to process sub nodes in deeper context
583				$node
584				}
585
586				sub downReverseX($$;@) # Reverse pre-order traversal down through a parse tree or sub tree calling the specified B_{within LB<{}> at each node and returning the specified starting node. The B_{is passed references to the current node and all of its L. The value of the current node is also made available via B<$_>.}}
587				{my ($node, $sub, @context) = @_; # Starting node, sub to call for each sub node, accumulated context.
588				my @n = $node->contents; # Clone the content array so that the tree can be modified if desired
589				&$sub(local $_ = $node, @context); # Process specified node first
590				$_->downReverseX($sub, $node, @context) for reverse @n; # Recurse to process sub nodes in deeper context
591				$node
592				}
593
594				#2 Pre and Post order # Visit the parent first, then the children, then the parent again.
595
596				sub through($$$;@) # Traverse parse tree visiting each node twice calling the specified B_{at each node and returning the specified starting node. The B_{s are passed references to the current node and all of its L. The value of the current node is also made available via B<$_>.}}
597				{my ($node, $before, $after, @context) = @_; # Starting node, sub to call when we meet a node, sub to call we leave a node, accumulated context.
598				my @n = $node->contents; # Clone the content array so that the tree can be modified if desired
599				&$before(local $_ = $node, @context); # Process specified node first with before()
600				$_->through($before, $after, $node, @context) for @n; # Recurse to process sub nodes in deeper context
601				&$after(local $_ = $node, @context); # Process specified node last with after()
602				$node
603				}
604
605				sub throughX($$$;@) # Traverse parse tree visiting each node twice calling the specified B_{within LB<{}> at each node and returning the specified starting node. The B_{is passed references to the current node and all of its L. The value of the current node is also made available via B<$_>.}}
606				{my ($node, $before, $after, @context) = @_; # Starting node, sub to call when we meet a node, sub to call we leave a node, accumulated context.
607				my @n = $node->contents; # Clone the content array so that the tree can be modified if desired
608				&$before(local $_ = $node, @context); # Process specified node first with before()
609				$_->throughX($before, $after, $node, @context) for @n; # Recurse to process sub nodes in deeper context
610				&$after(local $_ = $node, @context); # Process specified node last with after()
611				$node
612				}
613
614				#2 Range # Ranges of nodes
615
616				sub from($@) # Return a list consisting of the specified node and its following siblings optionally including only those nodes that match the specified context
617				{my ($start, @context) = @_; # Start node, optional context
618				my $p = $start->parent; # Parent node
619				confess "No parent" unless $p; # Not possible on a root node
620				my @c = $p->contents; # Content
621				shift @c while @c and $c[ 0] != $start; # Position on start node
622				return grep {$_->at(@context)} @c if @context; # Select matching nodes if requested
623				@c # Elements in the specified range
624				}
625
626				sub to($@) # Return a list of the siblings preceding the specified node and the specified node at optionally optionally including only those nodes that match the specified context
627				{my ($end, @context) = @_; # End node, optional context
628				my $q = $end->parent; # Parent node
629				confess "No parent" unless $q; # Not possible on a root node
630				my @c = $q->contents; # Content
631				pop @c while @c and $c[-1] != $end; # Position on end
632				return grep {$_->at(@context)} @c if @context; # Select matching nodes if requested
633				@c # Elements in the specified range
634				}
635
636				sub range($$@) # Return a list of the nodes between the specified start node and end node that optionally match the specified context.
637				{my ($start, $end, @context) = @_; # Start node, end node, optional context
638				my $p = $start->parent; # Parent node
639				confess "No parent" unless $p; # Not possible on a root node
640				my $q = $end->parent; # Parent node
641				confess "No parent" unless $q; # Not possible on a root node
642				confess "Not siblings" unless $p == $q; # Not possible unless the two nodes are siblings under the same parent
643				my @c = $p->contents; # Content
644				shift @c while @c and $c[ 0] != $start; # Position on start node
645				pop @c while @c and $c[-1] != $end; # Position on end
646				return grep {$_->at(@context)} @c if @context; # Select matching nodes if requested
647				@c # Elements in the specified range
648				}
649
650				#1 Position # Confirm that the position L to is the expected position.
651
652				sub at($@) #IX Confirm that the node has the specified L and return the starting node if it does else B. Ancestry is specified by providing the expected tag sof the parent, the parent's parent etc. If B is specified as a parent's tag then any tag is assumed to match.
653				{my ($start, @context) = @_; # Starting node, ancestry.
654				for(my $x = shift @_; $x; $x = $x->parent) # Up through parents
655				{return $start unless @_; # OK if no more required context
656				my $p = shift @_; # Next parent tag
657				next if !$p or $p eq $x->tag; # Carry on if contexts match
658				return undef # Error if required does not match actual
659				}
660				!@_ ? $start : undef # Top of the tree is OK as long as there is no more required context
661				}
662
663				sub ancestry($) # Return a list containing: (the specified node, its parent, its parent's parent etc..)
664				{my ($start) = @_; # Starting node.
665				my @a;
666				for(my $x = $start; $x; $x = $x->parent) # Up through parents
667				{push @a, $x;
668				}
669				@a # Return ancestry
670				}
671
672				sub context($) # Return a string containing the tag of the starting node and the tags of all its ancestors separated by single spaces.
673				{my ($start) = @_; # Starting node.
674				my @a; # Ancestors
675				for(my $p = $start; $p; $p = $p->parent)
676				{push @a, $p->tag;
677				@a < 100 or confess "Overly deep tree!";
678				}
679				join ' ', @a
680				}
681
682				sub containsSingleText($) # Return the singleton text element below this node else return B
683				{my ($node) = @_; # Node.
684				return undef unless $node->countTags == 2; # Must have just one child (plus the node itself)
685				my $f = $node->first; # Child element
686				return undef unless $f->isText; # Child element must be text
687				$f
688				}
689
690				sub depth($) # Returns the depth of the specified node, the depth of a root node is zero.
691				{my ($node) = @_; # Node.
692				my $a = 0;
693				for(my $x = $node->parent; $x; $x = $x->parent) {++$a} # Up through parents
694				$a # Return ancestry
695				}
696
697				sub isFirst($) #X Confirm that this node is the first node under its parent.
698				{my ($node) = @_; # Node.
699				my $parent = $node->parent; # Parent
700				return $node unless defined($parent); # The top most node is always first
701				$node == $parent->first ? $node : undef # First under parent
702				}
703
704				sub isLast($) #X Confirm that this node is the last node under its parent.
705				{my ($node) = @_; # Node.
706				my $parent = $node->parent; # Parent
707				return $node unless defined($parent); # The top most node is always last
708				$node == $parent->last ? $node : undef # Last under parent
709				}
710
711				sub isOnlyChild($@) #X Return the specified node if it is the only node under its parent (and ancestors) ignoring any surrounding blank text.
712				{my ($node, @tags) = @_; # Node, optional tags to confirm context.
713				return undef if @tags and !$node->at(@tags); # Confirm context if supplied
714				my $parent = $node->parent; # Find parent
715				return undef unless $parent; # Not an only child unless there is no parent
716				my @c = $parent->contents; # Contents of parent
717				return $node if @c == 1; # Only child if only one child
718				shift @c while @c and $c[ 0]->isBlankText; # Ignore leading blank text
719				pop @c while @c and $c[-1]->isBlankText; # Ignore trailing blank text
720				return $node if @c == 1; # Only child if only one child after leading and trailing blank text has been ignored
721				undef # Not the only child
722				}
723
724				sub isEmpty($) #X Confirm that this node is empty, that is: this node has no content, not even a blank string of text.
725				{my ($node) = @_; # Node.
726				!$node->first ? $node : undef # If it has no first descendant it must be empty
727				}
728
729				sub over($$) #X Confirm that the string representing the tags at the level below this node match a regular expression.
730				{my ($node, $re) = @_; # Node, regular expression.
731				$node->contentAsTags =~ m/$re/ ? $node : undef
732				}
733
734				sub matchAfter($$) #X Confirm that the string representing the tags following this node matches a regular expression.
735				{my ($node, $re) = @_; # Node, regular expression.
736				$node->contentAfterAsTags =~ m/$re/ ? $node : undef
737				}
738
739				sub matchBefore($$) #X Confirm that the string representing the tags preceding this node matches a regular expression
740				{my ($node, $re) = @_; # Node, regular expression
741				$node->contentBeforeAsTags =~ m/$re/ ? $node : undef
742				}
743
744				sub path($) # Return a list representing the path to a node which can then be reused by L to retrieve the node as long as the structure of the parse tree has not changed along the path.
745				{my ($node) = @_; # Node.
746				my $p = $node; # Current node
747				my @p; # Path
748				for(my $p = $node; $p and $p->parent; $p = $p->parent) # Go up
749				{my $i = $p->index; # Position in parent index
750				push @p, $i if $i; # Save position unless default
751				push @p, $p->tag; # Save index
752				}
753				reverse @p # Return path from root
754				}
755
756				sub pathString($) # Return a string representing the L to a node
757				{my ($node) = @_; # Node.
758				join ' ', path($node) # String representation
759				}
760
761				#1 Navigation # Move around in the parse tree
762
763				sub go($@) #IX Return the node reached from the specified node via the specified L: (index positionB)B<> where index is the tag of the next node to be chosen and position is the optional zero based position within the index of those tags under the current node. Position defaults to zero if not specified. Position can also be negative to index back from the top of the index array. B<> can be used as the last position to retrieve all nodes with the final tag.
764				{my ($node, @position) = @_; # Node, search specification.
765				my $p = $node; # Current node
766				while(@position) # Position specification
767				{my $i = shift @position; # Index name
768				return undef unless $p; # There is no node of the named type under this node
769				my $q = $p->indexes->{$i}; # Index
770				return undef unless defined $i; # Complain if no such index
771				if (@position) # Position within index
772				{if ($position[0] =~ /\A([-+]?\d+)\Z/) # Numeric position in index from start
773				{shift @position;
774				$p = $q->[$1]
775				}
776				elsif (@position == 1 and $position[0] =~ /\A\*\Z/) # Final index wanted
777				{return @$q;
778				}
779				else {$p = $q->[0]} # Step into first sub node by default
780				}
781				else {$p = $q->[0]} # Step into first sub node by default on last step
782				}
783				$p
784				}
785
786				sub c($$) # Return an array of all the nodes with the specified tag below the specified node.
787				{my ($node, $tag) = @_; # Node, tag.
788				my $c = $node->indexes->{$tag}; # Index for specified tags
789				$c ? @$c : () # Contents as an array
790				}
791
792				#2 First # Find nodes that are first amongst their siblings.
793
794				sub first($@) #BX Return the first node below this node optionally checking its context.
795				{my ($node, @context) = @_; # Node, optional context.
796				return $node->content->[0] unless @context; # Return first node if no context specified
797				my ($c) = $node->contents; # First node
798				$c ? $c->at(@context) : undef; # Return first node if in specified context
799				}
800
801				sub firstBy($@) # Return a list of the first instance of each specified tag encountered in a post-order traversal from the specified node or a hash of all first instances if no tags are specified.
802				{my ($node, @tags) = @_; # Node, tags to search for.
803				my %tags; # Tags found first
804				$node->byReverse(sub {$tags{$_->tag} = $_}); # Save first instance of each node
805				return %tags unless @tags; # Return hash of all tags encountered first unless @tags filter was specified
806				map {$tags{$_}} @tags; # Nodes in the requested order
807				}
808
809				sub firstDown($@) # Return a list of the first instance of each specified tag encountered in a pre-order traversal from the specified node or a hash of all first instances if no tags are specified.
810				{my ($node, @tags) = @_; # Node, tags to search for.
811				my %tags; # Tags found first
812				$node->downReverse(sub {$tags{$_->tag} = $_}); # Save first instance of each node
813				return %tags unless @tags; # Return hash of all tags encountered first unless @tags filter was specified
814				map {$tags{$_}} @tags; # Nodes in the requested order
815				}
816
817				sub firstIn($@) #X Return the first node matching one of the named tags under the specified node.
818				{my ($node, @tags) = @_; # Node, tags to search for.
819				my %tags = map {$_=>1} @tags; # Hashify tags
820				for($node->contents) # Search forwards through contents
821				{return $_ if $tags{$_->tag}; # Find first tag with the specified name
822				}
823				return undef # No such node
824				}
825
826				sub firstInIndex($@) #X Return the specified node if it is first in its index and optionally L the specified context else B
827				{my ($node, @context) = @_; # Node, optional context.
828				return undef if @context and !$node->at(@context); # Check the context if supplied
829				my $parent = $node->parent; # Parent
830				return undef unless $parent; # The root node is not first in anything
831				my @c = $parent->c($node->tag); # Index containing node
832				@c && $c[0] == $node ? $node : undef # First in index ?
833				}
834
835				sub firstContextOf($@) #X Return the first node encountered in the specified context in a depth first post-order traversal of the parse tree.
836				{my ($node, @context) = @_; # Node, array of tags specifying context.
837				my $x; # Found node if found
838				eval # Trap the die which signals success
839				{$node->by(sub # Traverse parse tree in depth first order
840				{my ($o) = @_;
841				if ($o->at(@context)) # Does this node match the supplied context?
842				{$x = $o; # Success
843				die "success!"; # Halt the search
844				}
845				});
846				};
847				confess $@ if $@ and $@ !~ /success!/; # Report any suppressed error messages at this point
848				$x # Return node found if we are still alive
849				}
850
851				#2 Last # Find nodes that are last amongst their siblings.
852
853				sub last($@) #BX Return the last node below this node optionally checking its context.
854				{my ($node, @context) = @_; # Node, optional context.
855				return $node->content->[-1] unless @context; # Return last node if no context specified
856				my ($c) = reverse $node->contents; # Last node
857				$c ? $c->at(@context) : undef; # Return last node if in specified context
858				}
859
860				sub lastBy($@) # Return a list of the last instance of each specified tag encountered in a post-order traversal from the specified node or a hash of all first instances if no tags are specified.
861				{my ($node, @tags) = @_; # Node, tags to search for.
862				my %tags; # Tags found first
863				$node->by(sub {$tags{$_->tag} = $_}); # Save last instance of each node
864				return %tags unless @tags; # Return hash of all tags encountered last unless @tags filter was specified
865				map {$tags{$_}} @tags; # Nodes in the requested order
866				}
867
868				sub lastDown($@) # Return a list of the last instance of each specified tag encountered in a pre-order traversal from the specified node or a hash of all first instances if no tags are specified.
869				{my ($node, @tags) = @_; # Node, tags to search for.
870				my %tags; # Tags found first
871				$node->down(sub {$tags{$_->tag} = $_}); # Save last instance of each node
872				return %tags unless @tags; # Return hash of all tags encountered last unless @tags filter was specified
873				map {$tags{$_}} @tags; # Nodes in the requested order
874				}
875
876				sub lastIn($@) #X Return the first node matching one of the named tags under the specified node.
877				{my ($node, @tags) = @_; # Node, tags to search for.
878				my %tags = map {$_=>1} @tags; # Hashify tags
879				for(reverse $node->contents) # Search backwards through contents
880				{return $_ if $tags{$_->tag}; # Find last tag with the specified name
881				}
882				return undef # No such node
883				}
884
885				sub lastInIndex($@) #X Return the specified node if it is last in its index and optionally L the specified context else B
886				{my ($node, @context) = @_; # Node, optional context.
887				return undef if @context and !$node->at(@context); # Check the context if supplied
888				my $parent = $node->parent; # Parent
889				return undef unless $parent; # The root node is not first in anything
890				my @c = $parent->c($node->tag); # Index containing node
891				@c && $c[-1] == $node ? $node : undef # Last in index ?
892				}
893
894				sub lastContextOf($@) #X Return the last node encountered in the specified context in a depth first reverse pre-order traversal of the parse tree.
895				{my ($node, @context) = @_; # Node, array of tags specifying context.
896				my $x; # Found node if found
897				eval # Trap the die which signals success
898				{$node->downReverse(sub # Traverse parse tree in depth first order
899				{my ($o) = @_;
900				if ($o->at(@context)) # Does this node match the supplied context?
901				{$x = $o; # Success
902				die "success!"; # Halt the search
903				}
904				});
905				};
906				confess $@ if $@ and $@ !~ /success!/; # Report any suppressed error messages at this point
907				$x # Return node found if we are still alive
908				}
909
910				#2 Next # Find sibling nodes after the specified node.
911
912				sub next($@) #BX Return the node next to the specified node, optionally checking its context.
913				{my ($node, @context) = @_; # Node, optional context.
914				return undef if $node->isLast; # No node follows the last node at a level or the top most node
915				my @c = $node->parent->contents; # Content array of parent
916				while(@c) # Test until no more nodes left to test
917				{my $c = shift @c; # Each node
918				if ($c == $node) # Current node
919				{my $n = shift @c; # Next node
920				return undef if @context and !$n->at(@context); # Next node is not in specified context
921				return $n; # Found node
922				}
923				}
924				confess "Node not found in parent"; # Something wrong with parent/child relationship
925				}
926
927				sub nextIn($@) #X Return the next node matching one of the named tags.
928				{my ($node, @tags) = @_; # Node, tags to search for.
929				my %tags = map {$_=>1} @tags; # Hashify tags
930				my $parent = $node->parent; # Parent node
931				return undef unless $parent; # No nodes follow the root node
932				my @c = $parent->contents; # Search forwards through contents
933				shift @c while @c and $c[0] != $node; # Move up to starting node
934				shift @c; # Move over starting node
935				for(@c) # Each subsequent node
936				{return $_ if $tags{$_->tag}; # Find first tag with the specified name in the remaining nodes
937				}
938				return undef # No such node
939				}
940
941				sub nextOn($@) # Step forwards as far as possible while remaining on nodes with the specified tags and return the last such node reached or the starting node if no such steps are possible.
942				{my ($node, @tags) = @_; # Start node, tags identifying nodes that can be step on to context.
943				return $node if $node->isLast; # Easy case
944				my $parent = $node->parent; # Parent node
945				confess "No parent" unless $parent; # Not possible on a root node
946				my @c = $parent->contents; # Content
947				shift @c while @c and $c[0] != $node; # Position on current node
948				confess "Node not found in parent" unless @c; # Something wrong with parent/child relationship
949				my %tags = map {$_=>1} @tags; # Hashify tags of acceptable commands
950				shift @c while @c > 1 and $tags{$c[1]->tag}; # Proceed forwards but staying on acceptable tags
951				return $c[0] # Current node or last acceptable tag reached while staying on acceptable tags
952				}
953
954				#2 Prev # Find sibling nodes before the specified node.
955
956				sub prev($@) #BX Return the node before the specified node, optionally checking its context.
957				{my ($node, @context) = @_; # Node, optional context.
958				return undef if $node->isFirst; # No node follows the last node at a level or the top most node
959				my @c = $node->parent->contents; # Content array of parent
960				while(@c) # Test until no more nodes left to test
961				{my $c = pop @c; # Each node
962				if ($c == $node) # Current node
963				{my $n = pop @c; # Prior node
964				return undef if @context and !$n->at(@context); # Prior node is not in specified context
965				return $n; # Found node
966				}
967				}
968				confess "Node not found in parent"; # Something wrong with parent/child relationship
969				}
970
971				sub prevIn($@) #X Return the next previous node matching one of the named tags.
972				{my ($node, @tags) = @_; # Node, tags to search for.
973				my %tags = map {$_=>1} @tags; # Hashify tags
974				my $parent = $node->parent; # Parent node
975				return undef unless $parent; # No nodes follow the root node
976				my @c = reverse $parent->contents; # Reverse through contents
977				shift @c while @c and $c[0] != $node; # Move down to starting node
978				shift @c; # Move over starting node
979				for(@c) # Each subsequent node
980				{return $_ if $tags{$_->tag}; # Find first tag with the specified name in the remaining nodes
981				}
982				return undef # No such node
983				}
984
985				sub prevOn($@) # Step backwards as far as possible while remaining on nodes with the specified tags and return the last such node reached or the starting node if no such steps are possible.
986				{my ($node, @tags) = @_; # Start node, tags identifying nodes that can be step on to context.
987				return $node if $node->isFirst; # Easy case
988				my $parent = $node->parent; # Parent node
989				confess "No parent" unless $parent; # Not possible on a root node
990				my @c = reverse $parent->contents; # Content backwards
991				shift @c while @c and $c[0] != $node; # Position on current node
992				confess "Node not found in parent" unless @c; # Something wrong with parent/child relationship
993				my %tags = map {$_=>1} @tags; # Hashify tags of acceptable commands
994				shift @c while @c > 1 and $tags{$c[1]->tag}; # Proceed forwards but staying on acceptable tags
995				return $c[0] # Current node or last acceptable tag reached while staying on acceptable tags
996				}
997
998				#2 Upto # Methods for moving up the parse tree from a node.
999
1000				sub upto($@) #X Return the first ancestral node that matches the specified context.
1001				{my ($node, @tags) = @_; # Start node, tags identifying context.
1002				for(my $p = $node; $p; $p = $p->parent) # Go up
1003				{return $p if $p->at(@tags); # Return node which satisfies the condition
1004				}
1005				return undef # Not found
1006				}
1007
1008				#1 Editing # Edit the data in the parse tree and change the structure of the parse tree by L nodes, by L nodes, by L nodes, by L nodes, by L nodes or by adding node as L
1009
1010				sub change($$@) #IX Change the name of a node, optionally confirming that the node is in a specified context and return the node.
1011				{my ($node, $name, @tags) = @_; # Node, new name, optional: tags defining the required context.
1012				return undef if @tags and !$node->at(@tags);
1013				$node->tag = $name; # Change name
1014				if (my $parent = $node->parent) {$parent->indexNode} # Reindex parent
1015				$node
1016				}
1017
1018				#2 Cut and Put # Move nodes around in the parse tree by cutting and pasting them
1019
1020				sub cut($) #I Cut out a node so that it can be reinserted else where in the parse tree.
1021				{my ($node) = @_; # Node to cut out.
1022				my $parent = $node->parent; # Parent node
1023				# confess "Already cut out" unless $parent; # We have to let thing be cut out more than once or supply an isCutOut() method
1024				return $node unless $parent; # Uppermost node is already cut out
1025				my $c = $parent->content; # Content array of parent
1026				my $i = $node->position; # Position in content array
1027				splice(@$c, $i, 1); # Remove node
1028				$parent->indexNode; # Rebuild indices
1029				$node->disconnectLeafNode; # Disconnect node no longer in parse tree
1030				$node # Return node
1031				}
1032
1033				sub putFirst($$) # Place a L at the front of the content of the specified node and return the new node.
1034				{my ($old, $new) = @_; # Original node, new node.
1035				$new->parent and confess "Please cut out the node before moving it"; # The node must have be cut out first
1036				$new->parser == $new and $old->parser == $new and # Prevent a root node from being inserted into a sub tree
1037				confess "Recursive insertion attempted";
1038				$new->parser = $old->parser; # Assign the new node to the old parser
1039				unshift @{$old->content}, $new; # Content array of original node
1040				$old->indexNode; # Rebuild indices for node
1041				$new # Return the new node
1042				}
1043
1044				sub putLast($$) #I Place a L last in the content of the specified node and return the new node.
1045				{my ($old, $new) = @_; # Original node, new node.
1046				$new->parent and confess "Please cut out the node before moving it"; # The node must have be cut out first
1047				$new->parser == $new and $old->parser == $new and # Prevent a root node from being inserted into a sub tree
1048				confess "Recursive insertion attempted";
1049				$new->parser = $old->parser; # Assign the new node to the old parser
1050				push @{$old->content}, $new; # Content array of original node
1051				$old->indexNode; # Rebuild indices for node
1052				$new # Return the new node
1053				}
1054
1055				sub putNext($$) # Place a L just after the specified node and return the new node.
1056				{my ($old, $new) = @_; # Original node, new node.
1057				my $parent = $old->parent; # Parent node
1058				$parent or confess "Cannot place a node after the outermost node"; # The originating node must have a parent
1059				$new->parent and confess "Please cut out the node before moving it"; # The node must have be cut out first
1060				$new->parser == $new and $old->parser == $new and # Prevent a root node from being inserted into a sub tree
1061				confess "Recursive insertion attempted";
1062				$new->parser = $old->parser; # Assign the new node to the old parser
1063				my $c = $parent->content; # Content array of parent
1064				my $i = $old->position; # Position in content array
1065				splice(@$c, $i+1, 0, $new); # Insert new node after original node
1066				$new->parent = $parent; # Return node
1067				$parent->indexNode; # Rebuild indices for parent
1068				$new # Return the new node
1069				}
1070
1071				sub putPrev($$) # Place a L just before the specified node and return the new node.
1072				{my ($old, $new) = @_; # Original node, new node.
1073				my $parent = $old->parent; # Parent node
1074				$parent or confess "Cannot place a node after the outermost node"; # The originating node must have a parent
1075				$new->parent and confess "Please cut out the node before moving it"; # The node must have be cut out first
1076				$new->parser == $new and $old->parser == $new and # Prevent a root node from being inserted into a sub tree
1077				confess "Recursive insertion attempted";
1078				$new->parser = $old->parser; # Assign the new node to the old parser
1079				my $c = $parent->content; # Content array of parent
1080				my $i = $old->position; # Position in content array
1081				splice(@$c, $i, 0, $new); # Insert new node before original node
1082				$new->parent = $parent; # Return node
1083				$parent->indexNode; # Rebuild indices for parent
1084				$new # Return the new node
1085				}
1086
1087				#2 Fusion # Join consecutive nodes
1088
1089				sub concatenate($$) # Concatenate two successive nodes and return the target node.
1090				{my ($target, $source) = @_; # Target node to replace, node to concatenate.
1091				$source->parser or confess "Cannot concatenate the root node"; # Complain if we try and concatenate the root
1092				if ($source = $target->next)
1093				{$target->content = [$target->contents, $source->contents]; # Concatenate (target, source) to target
1094				}
1095				elsif ($source = $target->prev)
1096				{$target->content = [$source->contents, $target->contents]; # Concatenate (source, target) to target
1097				}
1098				else
1099				{confess "Cannot concatenate non consecutive nodes"; # Complain if the nodes are not adjacent
1100				}
1101				$source->content = []; # Concatenate
1102				$target->indexNode; # Index target node
1103				$source->indexNode; # Index source node
1104				$source->cut;
1105				$target # Return new node
1106				}
1107
1108				sub concatenateSiblings($) # Concatenate preceding and following nodes as long as they have the same tag as the specified node and return the specified node.
1109				{my ($node) = @_; # Concatenate around this node.
1110				my $t = $node->tag; # The tag to match
1111				while(my $p = $node->prev)
1112				{last unless $p->tag eq $t; # Stop when the siblings no longer match
1113				$node->concatenate($p)
1114				}
1115				while(my $n = $node->next)
1116				{last unless $n->tag eq $t; # Stop when the siblings no longer match
1117				$node->concatenate($n) if $n->tag eq $t
1118				}
1119				$node # Return concatenating node
1120				}
1121
1122				#2 Put as text # Add text to the parse tree.
1123
1124				sub putFirstAsText($$) # Add a new text node first under a parent and return the new text node.
1125				{my ($node, $text) = @_; # The parent node, the string to be added which might contain unparsed Xml as well as text.
1126				$node->putFirst(my $t = $node->newText($text)); # Add new text node
1127				$t # Return new node
1128				}
1129
1130				sub putLastAsText($$) # Add a new text node last under a parent and return the new text node.
1131				{my ($node, $text) = @_; # The parent node, the string to be added which might contain unparsed Xml as well as text.
1132				$node->putLast(my $t = $node->newText($text)); # Add new text node
1133				$t # Return new node
1134				}
1135
1136				sub putNextAsText($$) # Add a new text node following this node and return the new text node.
1137				{my ($node, $text) = @_; # The parent node, the string to be added which might contain unparsed Xml as well as text.
1138				$node->putNext(my $t = $node->newText($text)); # Add new text node
1139				$t # Return new node
1140				}
1141
1142				sub putPrevAsText($$) # Add a new text node following this node and return the new text node
1143				{my ($node, $text) = @_; # The parent node, the string to be added which might contain unparsed Xml as well as text
1144				$node->putPrev(my $t = $node->newText($text)); # Add new text node
1145				$t # Return new node
1146				}
1147
1148				#2 Break in and out # Break nodes out of nodes or push them back
1149
1150				sub breakIn($) # Concatenate the nodes following and preceding the start node, unwrapping nodes whose tag matches the start node and return the start node. To concatenate only the preceding nodes, use L, to concatenate only the following nodes, use L.
1151				{my ($start) = @_; # The start node.
1152				$start->breakInBackwards; # The nodes before the start node
1153				$start->breakInForwards # The nodes following the start node
1154				}
1155
1156				sub breakInForwards($) # Concatenate the nodes following the start node, unwrapping nodes whose tag matches the start node and return the start node in the manner of L.
1157				{my ($start) = @_; # The start node.
1158				my $tag = $start->tag; # The start node tag
1159				for my $item($start->contentAfter) # Each item following the start node
1160				{$start->putLast($item->cut); # Concatenate item
1161				if ($item->tag eq $tag) # Unwrap items with the same tag as the start node
1162				{$item->unwrap; # Start a new clone of the parent
1163				}
1164				}
1165				$start # Return the start node
1166				}
1167
1168				sub breakInBackwards($) # Concatenate the nodes preceding the start node, unwrapping nodes whose tag matches the start node and return the start node in the manner of L.
1169				{my ($start) = @_; # The start node.
1170				my $tag = $start->tag; # The start node tag
1171				for my $item(reverse $start->contentBefore) # Each item preceding the start node reversing from the start node
1172				{$start->putFirst($item->cut); # Concatenate item
1173				if ($item->tag eq $tag) # Unwrap items with the same tag as the start node
1174				{$item->unwrap; # Start a new clone of the parent
1175				}
1176				}
1177				$start # Return the start node
1178				}
1179
1180				sub breakOut($@) # Lift child nodes with the specified tags under the specified parent node splitting the parent node into clones and return the cut out original node.
1181				{my ($parent, @tags) = @_; # The parent node, the tags of the modes to be broken out.
1182				my %tags = map {$_=>1} @tags; # Tags to break out
1183				my %attributes = %{$parent->attributes}; # Attributes of parent
1184				my $parentTag = $parent->tag; # The tag of the parent
1185				my $p; # Clone of parent currently being built
1186				for my $item($parent->contents) # Each item
1187				{if ($tags{$item->tag}) # Item to break out
1188				{$parent->putPrev($item->cut); # Position item broken out
1189				$p = undef; # Start a new clone of the parent
1190				}
1191				else # Item to remain in situ
1192				{if (!defined($p)) # Create a new parent clone
1193				{$parent->putPrev($p = $parent->newTag($parent->tag, %attributes)); # Position new parent clone
1194				}
1195				$p->putLast($item->cut); # Move current item into parent clone
1196				}
1197				}
1198				$parent->cut # Remove the original copy of the parent from which the clones were made
1199				}
1200
1201				#2 Replace # Replace nodes in the parse tree with nodes or text
1202
1203				sub replaceWith($$) # Replace a node (and all its content) with a L (and all its content) and return the new node.
1204				{my ($old, $new) = @_; # Old node, new node.
1205				$new->parent and confess "Please cut out the node before moving it"; # The node must have be cut out first
1206				$new->parser == $new and $old->parser == $new and # Prevent a root node from being inserted into a sub tree
1207				confess "Recursive replacement attempted";
1208				if (my $parent = $old->parent) # Parent node of old node
1209				{my $c = $parent->content; # Content array of parent
1210				if (defined(my $i = $old->position)) # Position of old node in content array of parent
1211				{splice(@$c, $i, 1, $new); # Replace old node with new node
1212				$old->parent = undef; # Cut out node
1213				$parent->indexNode; # Rebuild indices for parent
1214				}
1215				}
1216				$new # Return new node
1217				}
1218
1219				sub replaceWithText($$) # Replace a node (and all its content) with a new text node and return the new node.
1220				{my ($old, $text) = @_; # Old node, text of new node.
1221				my $n = $old->replaceWith($old->newText($text)); # Create a new text node, replace the old node and return the result
1222				$n
1223				}
1224
1225				sub replaceWithBlank($) # Replace a node (and all its content) with a new blank text node and return the new node.
1226				{my ($old) = @_; # Old node, text of new node.
1227				my $n = $old->replaceWithText(' '); # Create a new text node, replace the old node with a new blank text node and return the result
1228				$n
1229				}
1230
1231				#2 Wrap and unwrap # Wrap and unwrap nodes to alter the depth of the parse tree
1232
1233				sub wrapWith($$@) #I Wrap the original node in a new node forcing the original node down deepening the parse tree; return the new wrapping node.
1234				{my ($old, $tag, %attributes) = @_; # Node, tag for the L, attributes for the L.
1235				my $new = newTag(undef, $tag, %attributes); # Create wrapping node
1236				$new->parser = $old->parser; # Assign the new node to the old parser
1237				if (my $par = $old->parent) # Parent node exists
1238				{my $c = $par->content; # Content array of parent
1239				my $i = $old->position; # Position in content array
1240				splice(@$c, $i, 1, $new); # Replace node
1241				$old->parent = $new; # Set parent of original node as wrapping node
1242				$new->parent = $par; # Set parent of wrapping node
1243				$new->content = [$old]; # Create content for wrapping node
1244				$par->indexNode; # Rebuild indices for parent
1245				}
1246				else # At the top - no parent
1247				{$new->content = [$old]; # Create content for wrapping node
1248				$old->parent = $new; # Set parent of original node as wrapping node
1249				$new->parent = undef; # Set parent of wrapping node - there is none
1250				}
1251				$new->indexNode; # Create index for wrapping node
1252				$new # Return wrapping node
1253				}
1254
1255				sub wrapUp($@) # Wrap the original node in a sequence of new nodes forcing the original node down deepening the parse tree; return the array of wrapping nodes.
1256				{my ($node, @tags) = @_; # Node to wrap, tags to wrap the node with - with the uppermost tag rightmost.
1257				map {$node = $node->wrapWith($_)} @tags; # Wrap up
1258				}
1259
1260				sub wrapDown($@) # Wrap the content of the specified node in a sequence of new nodes forcing the original node up deepening the parse tree; return the array of wrapping nodes.
1261				{my ($node, @tags) = @_; # Node to wrap, tags to wrap the node with - with the uppermost tag rightmost.
1262				map {$node = $node->wrapContentWith($_)} @tags; # Wrap up
1263				}
1264
1265				sub wrapContentWith($$@) # Wrap the content of a node in a new node, the original content then contains the new node which contains the original node's content; returns the new wrapped node.
1266				{my ($old, $tag, %attributes) = @_; # Node, tag for new node, attributes for new node.
1267				my $new = newTag(undef, $tag, %attributes); # Create wrapping node
1268				$new->parser = $old->parser; # Assign the new node to the old parser
1269				$new->content = $old->content; # Transfer content
1270				$old->content = [$new]; # Insert new node
1271				$new->indexNode; # Create indices for new node
1272				$old->indexNode; # Rebuild indices for old mode
1273				$new # Return new node
1274				}
1275
1276				sub wrapTo($$$@) #X Wrap all the nodes starting and ending at the specified nodes with a new node with the specified tag and attributes and return the new node. Return B if the start and end nodes are not siblings - they must have the same parent for this method to work.
1277				{my ($start, $end, $tag, %attributes) = @_; # Start node, end node, tag for the wrapping node, attributes for the wrapping node
1278				my $parent = $start->parent; # Parent
1279				confess "Start node has no parent" unless $parent; # Not possible unless the start node has a parent
1280				confess "End node has a different parent" unless $parent = $end->parent; # Not possible unless the start and end nodes have the same parent
1281				my $s = $start->position; # Start position
1282				my $e = $end->position; # End position
1283				confess "End node precedes start node" if $e < $s; # End must not precede start node
1284				$start->putPrev(my $new = $start->newTag($tag, %attributes)); # Create and insert wrapping node
1285				my @c = $parent->contents; # Content of parent
1286				$new->putLast($c[$_]->cut) for $s+1..$e+1; # Move the nodes from start to end into the new node remembering that the new node has already been inserted
1287				$new # Return new node
1288				}
1289
1290				sub unwrap($) #I Unwrap a node by inserting its content into its parent at the point containing the node and return the parent node.
1291				{my ($node) = @_; # Node to unwrap.
1292				my $parent = $node->parent; # Parent node
1293				$parent or confess "Cannot unwrap the outer most node";
1294				if ($node->isEmpty) # Empty nodes can just be cut out
1295				{$node->cut;
1296				}
1297				else
1298				{my $p = $parent->content; # Content array of parent
1299				my $n = $node->content; # Content array of node
1300				my $i = $node->position; # Position of node in parent
1301				splice(@$p, $i, 1, @$n); # Replace node with its content
1302				$parent->indexNode; # Rebuild indices for parent
1303				$node->disconnectLeafNode; # Disconnect node from parse tree
1304				}
1305				$parent # Return the parent node
1306				}
1307
1308				#1 Contents # The children of each node.
1309
1310				sub contents($) # Return all the nodes contained by this node either as an array or as a reference to such an array.
1311				{my ($node) = @_; # Node.
1312				my $c = $node->content; # Contents reference
1313				$c ? @$c : () # Contents as an array
1314				}
1315
1316				sub contentAfter($) # Return all the sibling following this node.
1317				{my ($node) = @_; # Node.
1318				my $parent = $node->parent; # Parent
1319				return () if !$parent; # The uppermost node has no content beyond it
1320				my @c = $parent->contents; # Contents of parent
1321				while(@c) # Test until no more nodes left to test
1322				{my $c = shift @c; # Position of current node
1323				return @c if $c == $node # Nodes beyond this node if it is the searched for node
1324				}
1325				confess "Node not found in parent"; # Something wrong with parent/child relationship
1326				}
1327
1328				sub contentBefore($) # Return all the sibling preceding this node.
1329				{my ($node) = @_; # Node.
1330				my $parent = $node->parent; # Parent
1331				return () if !$parent; # The uppermost node has no content beyond it
1332				my @c = $parent->contents; # Contents of parent
1333				while(@c) # Test until no more nodes left to test
1334				{my $c = pop @c; # Position of current node
1335				return @c if $c == $node # Nodes beyond this node if it is the searched for node
1336				}
1337				confess "Node not found in parent"; # Something wrong with parent/child relationship
1338				}
1339
1340				sub contentAsTags($) # Return a string containing the tags of all the nodes contained by this node separated by single spaces.
1341				{my ($node) = @_; # Node.
1342				join ' ', map {$_->tag} $node->contents
1343				}
1344
1345				sub contentAfterAsTags($) # Return a string containing the tags of all the sibling nodes following this node separated by single spaces.
1346				{my ($node) = @_; # Node.
1347				join ' ', map {$_->tag} $node->contentAfter
1348				}
1349
1350				sub contentBeforeAsTags($) # # Return a string containing the tags of all the sibling nodes preceding this node separated by single spaces.
1351				{my ($node) = @_; # Node.
1352				join ' ', map {$_->tag} $node->contentBefore
1353				}
1354
1355				sub position($) # Return the index of a node in its parent's content.
1356				{my ($node) = @_; # Node.
1357				my @c = $node->parent->contents; # Each node in parent content
1358				for(keys @c) # Test each node
1359				{return $_ if $c[$_] == $node; # Return index position of node which counts from zero
1360				}
1361				confess "Node not found in parent"; # Something wrong with parent/child relationship
1362				}
1363
1364				sub index($) # Return the index of a node in its parent index.
1365				{my ($node) = @_; # Node.
1366				if (my @c = $node->parent->c($node->tag)) # Each node in parent index
1367				{for(keys @c) # Test each node
1368				{return $_ if $c[$_] == $node; # Return index position of node which counts from zero
1369				}
1370				}
1371				confess "Node not found in parent"; # Something wrong with parent/child relationship
1372				}
1373
1374				sub present($@) # Return the count of the number of the specified tag types present immediately under a node or a hash {tag} = count for all the tags present under the node if no names are specified.
1375				{my ($node, @names) = @_; # Node, possible tags immediately under the node.
1376				my %i = %{$node->indexes}; # Index of child nodes
1377				return map {$_=>scalar @{$i{$_}}} keys %i unless @names; # Hash of all names
1378				grep {$i{$_}} @names # Count of tag types present
1379				}
1380
1381				sub isText($) #X Confirm that this is a text node.
1382				{my ($node) = @_; # Node to test.
1383				$node->tag eq cdata ? $node : undef
1384				}
1385
1386				sub isBlankText($) #X Confirm that this node either contains no children or if it does, that they are all blank text
1387				{my ($node) = @_; # Node to test.
1388
1389				$node->isText && $node->text =~ /\A\s*\Z/s ? $node : undef
1390				}
1391
1392				sub bitsNodeTextBlank # Return a bit string that shows if there are tags, text, blank text under a node. An empty string is returned if there are no child nodes
1393				{my ($node) = @_; # Node to test.
1394				my ($n, $t, $b) = (0,0,0); # Non text, text, blank text count
1395				my @c = $node->contents; # Contents of node
1396				return '' unless @c; # Return empty string if no children
1397
1398				for(@c) # Contents of node
1399				{if ($_->isText) # Text node
1400				{++$t;
1401				++$b if $_->isBlankText; # Blank text node
1402				}
1403				else # Non text node
1404				{++$n;
1405				}
1406				}
1407				join '', map {$_ ? 1 : 0} ($n, $t, $b); # Multiple content so there must be some tags present because L concatenates contiguous text
1408				}
1409
1410				#1 Order # Number and verify the order of nodes.
1411
1412				sub findByNumber($$) #X Find the node with the specified number as made visible by L in the parse tree containing the specified node and return the found node or B if no such node exists.
1413				{my ($node, $number) = @_; # Node in the parse tree to search, number of the node required.
1414				$node->parser->numbers->[$number]
1415				}
1416
1417				sub findByNumbers($@) # Find the nodes with the specified numbers as made visible by L in the parse tree containing the specified node and return the found nodes in a list with B for nodes that do not exist.
1418				{my ($node, @numbers) = @_; # Node in the parse tree to search, numbers of the nodes required.
1419				map {$node->findByNumber($_)} @numbers # Node corresponding to each number
1420				}
1421
1422				sub numberNode($) #P Ensure that this node has a number.
1423				{my ($node) = @_; # Node
1424				my $n = $node->number = ++($node->parser->numbering); # Number node
1425				$node->parser->numbers->[$n] = $node # Index the nodes in a parse tree
1426				}
1427
1428				sub numberTree($) # Number the parse tree
1429				{my ($node) = @_; # Node
1430				my $parser = $node->parser; # Top of tree
1431				my $n = 0; # Node number
1432				$parser->down(sub {$parser->numbers->[$_->number = ++$n] = $_}); # Index the nodes in a parse tree in pre-order so they are numbered in the same sequence that they appear in the source
1433				}
1434
1435				sub above($$) #X Return the specified node if it is above the specified target otherwise B
1436				{my ($node, $target) = @_; # Node, target.
1437				return undef if $node == $target; # A node cannot be above itself
1438				my @n = $node ->ancestry;
1439				my @t = $target->ancestry;
1440				pop @n, pop @t while @n and @t and $n[-1] == $t[-1]; # Find first different ancestor
1441				!@n ? $node : undef # Node is above target if its ancestors are all ancestors of target
1442				}
1443
1444				sub below($$) #X Return the specified node if it is below the specified target otherwise B
1445				{my ($node, $target) = @_; # Node, target.
1446				$target->above($node); # The target must be above the node if the node is below the target
1447				}
1448
1449				sub after($$) #X Return the specified node if it occurs after the target node in the parse tree or else B if the node is L, L or L the target.
1450				{my ($node, $target) = @_; # Node, targe.t
1451				my @n = $node ->ancestry;
1452				my @t = $target->ancestry;
1453				pop @n, pop @t while @n and @t and $n[-1] == $t[-1]; # Find first different ancestor
1454				return undef unless @n and @t; # Undef if we cannot decide
1455				$n[-1]->position > $t[-1]->position # Node relative to target at first common ancestor
1456				}
1457
1458				sub before($$) #X Return the specified node if it occurs before the target node in the parse tree or else B if the node is L, L or L the target.
1459				{my ($node, $target) = @_; # Node, target.
1460				my @n = $node ->ancestry;
1461				my @t = $target->ancestry;
1462				pop @n, pop @t while @n and @t and $n[-1] == $t[-1]; # Find first different ancestor
1463				return undef unless @n and @t; # Undef if we cannot decide
1464				$n[-1]->position < $t[-1]->position # Node relative to target at first common ancestor
1465				}
1466
1467				sub disordered($@) # Return the first node that is out of the specified order when performing a pre-ordered traversal of the parse tree.
1468				{my ($node, @nodes) = @_; # Node, following nodes.
1469				my $c = $node; # Node we are currently checking for
1470				$node->parser->down(sub {$c = shift @nodes while $c and $_ == $c}); # Preorder traversal from root looking for each specified node
1471				$c # Disordered if we could not find this node
1472				}
1473
1474				sub commonAncestor($@) #X Find the most recent common ancestor of the specified nodes or B if there is no common ancestor.
1475				{my ($node, @nodes) = @_; # Node, @nodes
1476				return $node unless @nodes; # A single node is it its own common ancestor
1477				my @n = $node->ancestry; # The common ancestor so far
1478				for(@nodes) # Each node
1479				{my @t = $_->ancestry; # Ancestry of latest node
1480				my @c; # Common ancestors
1481				while(@n and @t and $n[-1] == $t[-1]) # Find common ancestors
1482				{push @c, pop @n; pop @t; # Save common ancestor
1483				}
1484				return undef unless @c; # No common ancestors
1485				@n = reverse @c; # Update common ancestry so far
1486				}
1487				$n[0] # Most recent common ancestor
1488				}
1489
1490				sub ordered($@) #X Return the first node if the specified nodes are all in order when performing a pre-ordered traversal of the parse tree else return B
1491				{my ($node, @nodes) = @_; # Node, following nodes.
1492				&disordered(@_) ? undef : $node
1493				}
1494
1495				#1 Labels # Label nodes so that they can be cross referenced and linked by L
1496
1497				sub addLabels($@) # Add the named labels to the specified node and return that node.
1498				{my ($node, @labels) = @_; # Node in parse tree, names of labels to add.
1499				my $l = $node->labels;
1500				$l->{$_}++ for @labels;
1501				$node
1502				}
1503
1504				sub countLabels($) # Return the count of the number of labels at a node.
1505				{my ($node) = @_; # Node in parse tree.
1506				my $l = $node->labels; # Labels at node
1507				scalar keys %$l # Count of labels
1508				}
1509
1510				sub getLabels($) # Return the names of all the labels set on a node.
1511				{my ($node) = @_; # Node in parse tree.
1512				sort keys %{$node->labels}
1513				}
1514
1515				sub deleteLabels($@) # Delete the specified labels in the specified node or all labels if no labels have are specified and return that node.
1516				{my ($node, @labels) = @_; # Node in parse tree, names of the labels to be deleted
1517				$node->{labels} = {} unless @labels; # Delete all the labels if no labels supplied
1518				delete @{$node->{labels}}{@labels}; # Delete specified labels
1519				$node
1520				}
1521
1522				sub copyLabels($$) # Copy all the labels from the source node to the target node and return the source node.
1523				{my ($source, $target) = @_; # Source node, target node.
1524				$target->addLabels($source->getLabels); # Copy all the labels from the source to the target
1525				$source
1526				}
1527
1528				sub moveLabels($$) # Move all the labels from the source node to the target node and return the source node.
1529				{my ($source, $target) = @_; # Source node, target node.
1530				$target->addLabels($source->getLabels); # Copy all the labels from the source to the target
1531				$source->deleteLabels; # Delete all the labels from the source
1532				$source
1533				}
1534
1535				#1 Operators # Operator access to methods use the assign versions to avoid 'useless use of operator in void context' messages. Use the non assign versions to return the results of the underlying method call. Thus '/' returns the wrapping node, whilst '/=' does not. Assign operators always return their left hand side even though the corresponding method usually returns the modification on the right.
1536
1537				use overload
1538				'=' => sub{$_[0]},
1539				'**' => \&opNew,
1540				'-X' => \&opString,
1541				'@{}' => \&opContents,
1542				'<=' => \&opAt,
1543				'>>' => \&opPutFirst,
1544				'>>=' => \&opPutFirstAssign,
1545				'<<' => \&opPutLast,
1546				'<<=' => \&opPutLastAssign,
1547				'>' => \&opPutNext,
1548				'+=' => \&opPutNextAssign,
1549				'+' => \&opPutNext,
1550				'<' => \&opPutPrev,
1551				'-=' => \&opPutPrevAssign,
1552				'-' => \&opPutPrev,
1553				'x=' => \&opBy,
1554				'x' => \&opBy,
1555				'>=' => \&opGo,
1556				'*' => \&opWrapContentWith,
1557				'*=' => \&opWrapContentWith,
1558				'/' => \&opWrapWith,
1559				'/=' => \&opWrapWith,
1560				'%' => \&opAttr,
1561				'--' => \&opCut,
1562				'++' => \&opUnwrap,
1563				"fallback" => 1;
1564
1565				sub opString($$) # -B: L\m-b: L\m-c: L\m-e: L\m-f: L\m-l: L\m-M: L\m-o: L\m-p: L\m-r: L\m-s: L\m-S : L\m-t : L\m-u: L\m-z: L.
1566				{my ($node, $op) = @_; # Node, monadic operator.
1567				$op or confess;
1568				return $node->bitsNodeTextBlank if $op eq 'B';
1569				return $node->prev if $op eq 'b';
1570				return $node->next if $op eq 'c';
1571				return $node->prettyStringEnd if $op eq 'e';
1572				return $node->first if $op eq 'f';
1573				return $node->last if $op eq 'l';
1574				return $node->number if $op eq 'M';
1575				return $node->stringQuoted if $op eq 'o';
1576				return $node->prettyString if $op eq 'p';
1577				return $node->stringReplacingIdsWithLabels if $op eq 'r';
1578				return $node->string if $op eq 's';
1579				return $node->stringNode if $op eq 'S';
1580				return $node->tag if $op eq 't';
1581				return $node->id if $op eq 'u';
1582				return $node->prettyStringNumbered if $op eq 'z';
1583				confess "Unknown operator: $op";
1584				# A B C d g k M O R T w W x X
1585				}
1586
1587				sub opContents($) # @{} : content of a node.
1588				{my ($node) = @_; # Node.
1589				$node->content
1590				}
1591
1592				sub opAt($$) # <= : Check that a node is in the context specified by the referenced array of words.
1593				{my ($node, $context) = @_; # Node, reference to array of words specifying the parents of the desired node.
1594				ref($context) =~ m/array/is or
1595				confess "Array of words required to specify the context";
1596				$node->at(@$context);
1597				}
1598
1599				sub opNew($$) # ** : create a new node from the text on the right hand side: if the text contains a non word character \W the node will be create as text, else it will be created as a tag
1600				{my ($node, $text) = @_; # Node, name node of node to create or text of new text element
1601				return $text if ref($text) eq __PACKAGE__; # The right hand side is already a node
1602				return $node->newTag($text) unless $text =~ m/\W/s; # Create a new node as tag
1603				$node->newText($text) # Create a new node as text if nothing lse worked
1604				}
1605
1606				sub opPutFirst($$) # >> : put a node or string first under a node and return the new node.
1607				{my ($node, $text) = @_; # Node, node or text to place first under the node.
1608				$node->putFirst(my $new = opNew($node, $text));
1609				$new
1610				}
1611
1612				sub opPutFirstAssign($$) # >>= : put a node or string first under a node.
1613				{my ($node, $text) = @_; # Node, node or text to place first under the node.
1614				opPutFirst($node, $text);
1615				$node
1616				}
1617
1618				sub opPutLast($$) # << : put a node or string last under a node and return the new node.
1619				{my ($node, $text) = @_; # Node, node or text to place last under the node.
1620				$node->putLast(my $new = opNew($node, $text));
1621				$new
1622				}
1623
1624				sub opPutLastAssign($$) # <<= : put a node or string last under a node.
1625				{my ($node, $text) = @_; # Node, node or text to place last under the node.
1626				opPutLast($node, $text);
1627				$node
1628				}
1629
1630				sub opPutNext($$) # > + : put a node or string after the specified node and return the new node.
1631				{my ($node, $text) = @_; # Node, node or text to place after the first node.
1632				$node->putNext(my $new = opNew($node, $text));
1633				$new
1634				}
1635
1636				sub opPutNextAssign($$) # += : put a node or string after the specified node.
1637				{my ($node, $text) = @_; # Node, node or text to place after the first node.
1638				opPutNext($node, $text);
1639				$node
1640				}
1641
1642				sub opPutPrev($$) # < - : put a node or string before the specified node and return the new node.
1643				{my ($node, $text) = @_; # Node, node or text to place before the first node.
1644				$node->putPrev(my $new = opNew($node, $text));
1645				$new
1646				}
1647
1648				sub opPutPrevAssign($$) # -= : put a node or string before the specified node,
1649				{my ($node, $text) = @_; # Node, node or text to place before the first node.
1650				opPutPrev($node, $text);
1651				$node
1652				}
1653
1654				sub opBy($$) # x= : Traverse a parse tree in post-order.
1655				{my ($node, $code) = @_; # Parse tree, code to execute against each node.
1656				ref($code) =~ m/code/is or
1657				confess "sub reference required on right hand side";
1658				$node->by($code);
1659				}
1660
1661				sub opGo($$) # >= : Search for a node via a specification provided as a reference to an array of words each number. Each word represents a tag name, each number the index of the previous tag or zero by default.
1662				{my ($node, $go) = @_; # Node, reference to an array of search parameters.
1663				return $node->go(@$go) if ref($go);
1664				$node->go($go)
1665				}
1666
1667				sub opAttr($$) # % : Get the value of an attribute of this node.
1668				{my ($node, $attr) = @_; # Node, reference to an array of words and numbers specifying the node to search for.
1669				$node->attr($attr)
1670				}
1671
1672				#sub opSetTag($$) # + : Set the tag for a node.
1673				# {my ($node, $tag) = @_; # Node, tag.
1674				# $node->change($tag)
1675				# }
1676				#
1677				#sub opSetId($$) # - : Set the id for a node.
1678				# {my ($node, $id) = @_; # Node, id.
1679				# $node->setAttr(id=>$id);
1680				# }
1681
1682				sub opWrapWith($$) # / : Wrap node with a tag, returning the wrapping node.
1683				{my ($node, $tag) = @_; # Node, tag.
1684				$node->wrapWith($tag)
1685				}
1686
1687				sub opWrapContentWith($$) # * : Wrap content with a tag, returning the wrapping node.
1688				{my ($node, $tag) = @_; # Node, tag.
1689				$node->wrapContentWith($tag)
1690				}
1691
1692				sub opCut($) # -- : Cut out a node.
1693				{my ($node) = @_; # Node.
1694				$node->cut
1695				}
1696
1697				sub opUnwrap($) # ++ : Unwrap a node.
1698				{my ($node) = @_; # Node.
1699				$node->unwrap
1700				}
1701
1702				#1 Statistics # Statistics describing the parse tree.
1703
1704				sub count($@) # Return the count of the number of instances of the specified tags under the specified node, either by tag in array context or in total in scalar context.
1705				{my ($node, @names) = @_; # Node, possible tags immediately under the node.
1706				if (wantarray) # In array context return the count for each tag specified
1707				{my @c; # Count for the corresponding tag
1708				my %i = %{$node->indexes}; # Index of child nodes
1709				for(@names)
1710				{if (my $i = $i{$_}) {push @c, scalar(@$i)} else {push @c, 0}; # Save corresponding count
1711				}
1712				return @c; # Return count for each tag specified
1713				}
1714				else # In scalar context count the total number of instances of the named tags
1715				{if (@names)
1716				{my $c = 0; # Tag count
1717				my %i = %{$node->indexes}; # Index of child nodes
1718				for(@names)
1719				{if (my $i = $i{$_}) {$c += scalar(@$i)}
1720				}
1721				return $c;
1722				}
1723				else # In scalar context, with no tags specified, return the number of nodes under the specified node
1724				{my @c = $node->contents;
1725				return scalar(@c); # Count of all tags including CDATA
1726				}
1727				}
1728				confess "This should not happen"
1729				}
1730
1731				sub countTags($) # Count the number of tags in a parse tree.
1732				{my ($node) = @_; # Parse tree.
1733				my $n = 0;
1734				$node->by(sub{++$n}); # Count tags including CDATA
1735				$n # Number of tags encountered
1736				}
1737
1738				sub countTagNames($;$) # Return a hash showing the number of instances of each tag on and below the specified node.
1739				{my ($node, $count) = @_; # Node, count of tags so far.
1740				$count //= {}; # Counts
1741				$$count{$node->tag}++; # Add current tag
1742				$_->countTagNames($count) for $node->contents; # Each contained node
1743				$count # Count
1744				}
1745
1746				sub countAttrNames($;$) # Return a hash showing the number of instances of each attribute on and below the specified node.
1747				{my ($node, $count) = @_; # Node, count of attributes so far.
1748				$count //= {}; # Counts
1749				$$count{$_}++ for $node->getAttrs; # Attributes from current tga
1750				$_->countAttrNames($count) for $node->contents; # Each contained node
1751				$count # Count
1752				}
1753
1754				#1 Debug # Debugging methods
1755
1756				sub printAttributes($) #P Print the attributes of a node.
1757				{my ($node) = @_; # Node whose attributes are to be printed.
1758				my $a = $node->attributes; # Attributes
1759				defined($$a{$_}) ? undef : delete $$a{$_} for keys %$a; # Remove undefined attributes
1760				return '' unless keys %$a; # No attributes
1761				my $s = ' '; $s .= $_.'="'.$a->{$_}.'" ' for sort keys %$a; chop($s); # Attributes enclosed in "" in alphabetical order
1762				$s
1763				}
1764
1765				sub printAttributesReplacingIdsWithLabels($) #P Print the attributes of a node replacing the id with the labels.
1766				{my ($node) = @_; # Node whose attributes are to be printed.
1767				my %a = %{$node->attributes}; # Clone attributes
1768				my %l = %{$node->labels}; # Clone labels
1769				delete $a{id}; # Remove id
1770				$a{id} = join ', ', sort keys %l if keys %l; # Replace id with labels in cloned attributes
1771				defined($a{$_}) ? undef : delete $a{$_} for keys %a; # Remove undefined attributes
1772				return '' unless keys %a; # No attributes
1773				my $s = ' '; $s .= $_.'="'.$a{$_}.'" ' for sort keys %a; chop($s); # Attributes enclosed in "" in alphabetical order
1774				$s
1775				}
1776
1777				sub checkParentage($) #P Check the parent pointers are correct in a parse tree.
1778				{my ($x) = @_; # Parse tree.
1779				$x->by(sub
1780				{my ($o) = @_;
1781				for($o->contents)
1782				{my $p = $_->parent;
1783				$p == $o or confess "No parent: ". $_->tag;
1784				$p and $p == $o or confess "Wrong parent: ".$o->tag. ", ". $_->tag;
1785				}
1786				});
1787				}
1788
1789				sub checkParser($) #P Check that every node has a parser.
1790				{my ($x) = @_; # Parse tree.
1791				$x->by(sub
1792				{$_->parser or confess "No parser for ". $_->tag;
1793				$_->parser == $x or confess "Wrong parser for ". $_->tag;
1794				})
1795				}
1796
1797				sub nn($) #P Replace new lines in a string with N to make testing easier.
1798				{my ($s) = @_; # String.
1799				$s =~ s/\n/N/gsr
1800				}
1801
1802				# Tests and documentation
1803
1804				sub extractDocumentationFlags($$) # Generate documentation for a method with a user flag.
1805				{my ($flags, $method) = @_; # Flags, method name.
1806				my $b = "${method}NonBlank"; # Not blank method name
1807				my $x = "${method}NonBlankX"; # Not blank, die on undef method name
1808				my $m = $method; # Second action method
1809				$m =~ s/\Afirst/next/gs;
1810				$m =~ s/\Alast/prev/gs;
1811				my @doc; my @code;
1812				if ($flags =~ m/B/s)
1813				{push @doc, <
1814				Use B<$b> to skip a (rare) initial blank text CDATA. Use B<$x> to die rather
1815				then receive a returned B or false result.
1816				END
1817				push @code, <
1818				sub $b
1819				{my \$r = &$method(\$_[0]);
1820				return undef unless \$r;
1821				if (\$r->isBlankText)
1822				{shift \@_;
1823				return &$m(\$r, \@_)
1824				}
1825				else
1826				{return &$m(\@_);
1827				}
1828				}
1829
1830				sub $x
1831				{my \$r = &$b(\@_);
1832				die '$method' unless defined(\$r);
1833				\$r
1834				}
1835				END
1836				}
1837
1838				return [join("\n", @doc), join("\n", @code), [$b, $x]]
1839				}
1840
1841				# podDocumentation
1842
1843				=pod
1844
1845				=encoding utf-8
1846
1847				=head1 Name
1848
1849				Data::Edit::Xml - Edit data held in xml format
1850
1851				=head1 Synopsis
1852
1853				Create a L xml parse tree:
1854
1855				my $a = Data::Edit::Xml::new("");
1856
1857				L the parse tree:
1858
1859				say STDERR -p $a;
1860
1861				to get:
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872				L out B under B but not under B in the created tree
1873				by L in post-order L a B_{to each node}
1874				to L out B when we are L B under B under B.
1875
1876				In B
1877
1878				$a -> by(sub {$_ -> cut if $_ -> at(qw(c b a))});
1879
1880				In B style:
1881
1882				$a -> byX(sub {$_ -> at(qw(c b a)) -> cut});
1883
1884				In B style:
1885
1886				$a x= sub {--$_ if $_ <= [qw(c b a)]};
1887
1888				L the transformed parse tree
1889
1890				say STDERR -p $a;
1891
1892				to get:
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902				=head2 Bullets to unordered list
1903
1904				To transform a series of bullets in to ... first parse the input xml:
1905
1906				{my $a = Data::Edit::Xml::new(<
1907
1908				• Minimum 1 number
1909				• No leading, trailing, or embedded spaces
1910				• Not case-sensitive
1911
1912				END
1913
1914				Traverse the resulting parse tree, changing bullets to and either wrapping
1915				with or appending to a previous
1916
1917				$a->by(sub # Bulleted list to
1918				{if ($_->at(qw(p))) #
1919				{if (my $t = $_->containsSingleText) # with single text
1920				{if ($t->text =~ s(\A\x{2022}\s*) ()s) # Starting with a bullet
1921				{$_->change(qw(li)); # to
1922				if (my $p = $_->prev(qw(ul))) # Previous element is ul?
1923				{$p->putLast($_->cut); # Put in preceding list or create a new list
1924				}
1925				else
1926				{$_->wrapWith(qw(ul))
1927				}
1928				}
1929				}
1930				}
1931				});
1932
1933				To get:
1934
1935
1936
1937				Minimum 1 number
1938				No leading, trailing, or embedded spaces
1939				Not case-sensitive
1940
1941
1942
1943				=head2 DocBook to Dita
1944
1945				To transform some DocBook xml into Dita:
1946
1947				use Data::Edit::Xml;
1948
1949				# Parse the DocBook xml
1950
1951				my $a = Data::Edit::Xml::new(<
1952
1953
1954				Diagnose the problem
1955				This can be quite difficult
1956				Sometimes impossible
1957
1958
1959				ls -la
1960
1961				drwxr-xr-x 2 phil phil 4096 Jun 15 2016 Desktop
1962				drwxr-xr-x 2 phil phil 4096 Nov 9 20:26 Downloads
1963
1964
1965
1966				END
1967
1968				# Transform to Dita step 1
1969
1970				$a->by(sub
1971				{my ($o, $p) = @_;
1972				if ($o->at(qw(pre p li sli)) and $o->isOnlyChild)
1973				{$o->change($p->isFirst ? qw(cmd) : qw(stepresult));
1974				$p->unwrap;
1975				}
1976				elsif ($o->at(qw(li sli)) and $o->over(qr(\Ap( p)+\Z)))
1977				{$_->change($_->isFirst ? qw(cmd) : qw(info)) for $o->contents;
1978				}
1979				});
1980
1981				# Transform to Dita step 2
1982
1983				$a->by(sub
1984				{my ($o) = @_;
1985				$o->change(qw(step)) if $o->at(qw(li sli));
1986				$o->change(qw(steps)) if $o->at(qw(sli));
1987				$o->id = 's'.($o->position+1) if $o->at(qw(step));
1988				$o->id = 'i'.($o->index+1) if $o->at(qw(info));
1989				$o->wrapWith(qw(screen)) if $o->at(qw(CDATA stepresult));
1990				});
1991
1992				# Print the results
1993
1994				say STDERR -p $a;
1995
1996				Produces:
1997
1998
1999
2000				Diagnose the problem
2001
2002				This can be quite difficult
2003
2004				Sometimes impossible
2005
2006
2007
2008				ls -la
2009
2010
2011
2012				drwxr-xr-x 2 phil phil 4096 Jun 15 2016 Desktop
2013				drwxr-xr-x 2 phil phil 4096 Nov 9 20:26 Downloads
2014
2015
2016
2017
2018
2019				=head1 Description
2020
2021				The following sections describe the methods in each functional area of this
2022				module. For an alphabetic listing of all methods by name see L.
2023
2024
2025
2026				=head1 Immediately useful methods
2027
2028				These methods are the ones most likely to be of immediate use to anyone using
2029				this module for the first time:
2030
2031
2032				L
2033
2034				Confirm that the node has the specified L and return the starting node if it does else B. Ancestry is specified by providing the expected tag sof the parent, the parent's parent etc. If B is specified as a parent's tag then any tag is assumed to match.
2035
2036				L
2037
2038				Return the value of an attribute of the current node as an L B_.
2039
2040				L
2041
2042				Post-order traversal of a parse tree or sub tree calling the specified B_{at each node and returning the specified starting node. The B_{is passed references to the current node and all of its L. The value of the current node is also made available via B<$_>.}}
2043
2044				L
2045
2046				Change the name of a node, optionally confirming that the node is in a specified context and return the node.
2047
2048				L
2049
2050				Cut out a node so that it can be reinserted else where in the parse tree.
2051
2052				L
2053
2054				Return the node reached from the specified node via the specified L: (index positionB)B<> where index is the tag of the next node to be chosen and position is the optional zero based position within the index of those tags under the current node. Position defaults to zero if not specified. Position can also be negative to index back from the top of the index array. B<> can be used as the last position to retrieve all nodes with the final tag.
2055
2056				L
2057
2058				New parse - call this method statically as in Data::Edit::Xml::new(file or string) B with no parameters and then use L, L, L, L to provide specific parameters for the parse, then call L to perform the parse and return the parse tree.
2059
2060				L
2061
2062				Return a readable string representing a node of a parse tree and all the nodes below it. Or use L<-p\|/opString> $node
2063
2064				L
2065
2066				Place a L last in the content of the specified node and return the new node.
2067
2068				L
2069
2070				Unwrap a node by inserting its content into its parent at the point containing the node and return the parent node.
2071
2072				L
2073
2074				Wrap the original node in a new node forcing the original node down deepening the parse tree; return the new wrapping node.
2075
2076
2077
2078
2079				=head1 Construction
2080
2081				Create a parse tree, either by parsing a L, or, L, or, from another L'
2082
2083				=head2 File or String
2084
2085				Construct a parse tree from a file or a string
2086
2087				=head3 new($)
2088
2089				New parse - call this method statically as in Data::Edit::Xml::new(file or string) B with no parameters and then use L, L, L, L to provide specific parameters for the parse, then call L to perform the parse and return the parse tree.
2090
2091				1 $fileNameOrString File name or string
2092
2093				Example:
2094
2095
2096				my $x = Data::Edit::Xml::new(<
2097
2098
2099
2100
2101
2102
2103
2104
2105				END
2106
2107				ok -p $x eq <
2108
2109
2110
2111
2112
2113
2114
2115
2116				END
2117
2118
2119				This is a static method and so should be invoked as:
2120
2121				Data::Edit::Xml::new
2122
2123
2124				=head3 content :lvalue
2125
2126				Content of command: the nodes immediately below this node in the order in which they appeared in the source text, see also L.
2127
2128
2129				=head3 numbers :lvalue
2130
2131				Nodes by number.
2132
2133
2134				=head3 attributes :lvalue
2135
2136				The attributes of this node, see also: L. The frequently used attributes: class, id, href, outputclass can be accessed by an lvalue method as in: $node->id = 'c1'.
2137
2138
2139				=head3 conditions :lvalue
2140
2141				Conditional strings attached to a node, see L.
2142
2143
2144				=head3 indexes :lvalue
2145
2146				Indexes to sub commands by tag in the order in which they appeared in the source text.
2147
2148
2149				=head3 labels :lvalue
2150
2151				The labels attached to a node to provide addressability from other nodes, see: L.
2152
2153
2154				=head3 errorsFile :lvalue
2155
2156				Error listing file. Use this parameter to explicitly set the name of the file that will be used to write an parse errors to. By default this file is named: B.
2157
2158
2159				=head3 inputFile :lvalue
2160
2161				Source file of the parse if this is the parser root node. Use this parameter to explicitly set the file to be parsed.
2162
2163
2164				=head3 input :lvalue
2165
2166				Source of the parse if this is the parser root node. Use this parameter to specify some input either as a string or as a file name for the parser to convert into a parse tree.
2167
2168
2169				=head3 inputString :lvalue
2170
2171				Source string of the parse if this is the parser root node. Use this parameter to explicitly set the string to be parsed.
2172
2173
2174				=head3 number :lvalue
2175
2176				Number of this node, see L.
2177
2178
2179				=head3 numbering :lvalue
2180
2181				Last number used to number a node in this parse tree.
2182
2183
2184				=head3 parent :lvalue
2185
2186				Parent node of this node or undef if the oarser root node. See also L and L. Consider as read only.
2187
2188
2189				=head3 parser :lvalue
2190
2191				Parser details: the root node of a tree is the parse node for that tree. Consider as read only.
2192
2193
2194				=head3 tag :lvalue
2195
2196				Tag name for this node, see also L and L. Consider as read only.
2197
2198
2199				=head3 text :lvalue
2200
2201				Text of this node but only if it is a text node, i.e. the tag is cdata() <=> L is true.
2202
2203
2204				=head3 cdata()
2205
2206				The name of the tag to be used to represent text - this tag must not also be used as a command tag otherwise the parser will L.
2207
2208
2209				Example:
2210
2211
2212				ok Data::Edit::Xml::cdata eq q(CDATA);
2213
2214
2215				=head3 parse($)
2216
2217				Parse input xml specified via: L, L or L.
2218
2219				1 $parser Parser created by L
2220
2221				Example:
2222
2223
2224				my $x = Data::Edit::Xml::new;
2225
2226				$x->inputString = <
2227
2228				END
2229
2230				$x->parse;
2231
2232				ok -p $x eq <
2233
2234
2235
2236
2237
2238				END
2239
2240
2241				=head2 Node by Node
2242
2243				Construct a parse tree node by node.
2244
2245				=head3 newText($$)
2246
2247				Create a new text node.
2248
2249				1 undef Any reference to this package
2250				2 $text Content of new text node
2251
2252				Example:
2253
2254
2255				ok -p $x eq <
2256
2257
2258
2259				END
2260
2261				$x->putLast($x->newText("t"));
2262
2263				ok -p $x eq <
2264
2265
2266				t
2267
2268				END
2269
2270
2271				=head3 newTag($$%)
2272
2273				Create a new non text node.
2274
2275				1 undef Any reference to this package
2276				2 $command The tag for the node
2277				3 %attributes Attributes as a hash.
2278
2279				Example:
2280
2281
2282				my $x = Data::Edit::Xml::newTree("a", id=>1, class=>"aa");
2283
2284				$x->putLast($x->newTag("b", id=>2, class=>"bb"));
2285
2286				ok -p $x eq <
2287
2288
2289
2290				END
2291
2292
2293				=head3 newTree($%)
2294
2295				Create a new tree.
2296
2297				1 $command The name of the root node in the tree
2298				2 %attributes Attributes of the root node in the tree as a hash.
2299
2300				Example:
2301
2302
2303				my $x = Data::Edit::Xml::newTree("a", id=>1, class=>"aa");
2304
2305				ok -s $x eq '';
2306
2307
2308				=head3 replaceSpecialChars($)
2309
2310				Replace < > " with < > " Larry Wall's excellent L unfortunately replaces < > " & etc. with their expansions in text by default and does not seem to provide an obvious way to stop this behavior, so we have to put them back gain using this method. Worse, we cannot decide whether to replace & with & or leave it as is: consequently you might have to examine the instances of & in your output text and guess based on the context.
2311
2312				1 $string String to be edited.
2313
2314				Example:
2315
2316
2317				ok Data::Edit::Xml::replaceSpecialChars(q(<">)) eq "<">";
2318
2319
2320				=head2 Parse tree
2321
2322				Construct a parse tree from another parse tree
2323
2324				=head3 renew($)
2325
2326				Returns a renewed copy of the parse tree: use this method if you have added nodes via the L methods and wish to add them to the parse tree
2327
2328				1 $node Parse tree.
2329
2330				Example:
2331
2332
2333				my $a = Data::Edit::Xml::new("");
2334
2335				$a->putFirstAsText(qq());
2336
2337				ok !$a->go(q(b));
2338
2339				my $A = $a->renew;
2340
2341				ok -t $A->go(q(b)) eq q(b)
2342
2343
2344				=head3 clone($)
2345
2346				Return a clone of the parse tree: the parse tree is cloned without converting it to string and reparsing it so this method will not L any nodes added L.
2347
2348				1 $node Parse tree.
2349
2350				Example:
2351
2352
2353				my $a = Data::Edit::Xml::new(" ");
2354
2355				my $A = $a->clone;
2356
2357				ok -s $A eq q();
2358
2359				ok $a->equals($A);
2360
2361
2362				=head3 equals($$)
2363
2364				Return the first node if the two parse trees are equal, else B if they are not equal.
2365
2366				1 $node1 Parse tree 1
2367				2 $node2 Parse tree 2.
2368
2369				Example:
2370
2371
2372				my $a = Data::Edit::Xml::new(" ");
2373
2374				my $A = $a->clone;
2375
2376				ok -s $A eq q();
2377
2378				ok $a->equals($A);
2379
2380
2381				Use B to execute L but B 'equals' instead of returning B
2382
2383				=head3 save($$)
2384
2385				Save a copy of the parse tree to a file which can be L and return the saved node.
2386
2387				1 $node Parse tree
2388				2 $file File.
2389
2390				Example:
2391
2392
2393				$y->save($f);
2394
2395				my $Y = Data::Edit::Xml::restore($f);
2396
2397				ok $Y->equals($y);
2398
2399
2400				=head3 restore($)
2401
2402				Return a parse tree from a copy saved in a file by L.
2403
2404				1 $file File
2405
2406				Example:
2407
2408
2409				$y->save($f);
2410
2411				my $Y = Data::Edit::Xml::restore($f);
2412
2413				ok $Y->equals($y);
2414
2415
2416				Use B to execute L but B 'restore' instead of returning B
2417
2418				This is a static method and so should be invoked as:
2419
2420				Data::Edit::Xml::restore
2421
2422
2423				=head1 Print
2424
2425				Create a string representation of the parse tree with optional selection of nodes via L.
2426
2427				Normally use the methods in L to format the xml in a readable yet reparseable manner; use L string to format the xml densely in a reparseable manner; use the other methods to produce unreparseable strings conveniently formatted to assist various specialized operations such as debugging CDATA, using labels or creating tests. A number of the L can also be conveniently used to print parse trees in these formats.
2428
2429				=head2 Pretty
2430
2431				Pretty print the parse tree.
2432
2433				=head3 prettyString($$)
2434
2435				Return a readable string representing a node of a parse tree and all the nodes below it. Or use L<-p\|/opString> $node
2436
2437				1 $node Start node
2438				2 $depth Optional depth.
2439
2440				Example:
2441
2442
2443				my $s = <
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454				END
2455
2456				my $a = Data::Edit::Xml::new($s);
2457
2458				ok $s eq $a->prettyString;
2459
2460				ok $s eq -p $a;
2461
2462
2463				=head3 prettyStringNumbered($$)
2464
2465				Return a readable string representing a node of a parse tree and all the nodes below it with a L attached to each tag. The node numbers can then be used as described in L to monitor changes to the parse tree.
2466
2467				1 $node Start node
2468				2 $depth Optional depth.
2469
2470				Example:
2471
2472
2473				my $s = <
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484				END
2485
2486				$a->numberTree;
2487
2488				ok $a->prettyStringNumbered eq <
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499				END
2500
2501
2502				=head3 prettyStringCDATA($$)
2503
2504				Return a readable string representing a node of a parse tree and all the nodes below it with the text fields wrapped with ....
2505
2506				1 $node Start node
2507				2 $depth Optional depth.
2508
2509				Example:
2510
2511
2512				if (1)
2513
2514				$a->first->replaceWithBlank;
2515
2516				ok $a->prettyStringCDATA eq <
2517
2518				END
2519
2520				my $a = Data::Edit::Xml::new("1 23456789");
2521
2522				map {$_->replaceWithBlank} grep {$_->isText} $a->contents;
2523
2524				map {$_->cut} grep {$_->tag =~ m/\A[BDFH]\Z/} $a->contents;
2525
2526				ok $a->prettyStringCDATA eq <<'END';
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537				END
2538
2539
2540				=head3 prettyStringContent($)
2541
2542				Return a readable string representing all the nodes below a node of a parse tree - infrequent use and so capitalized to avoid being presented as an option by L.
2543
2544				1 $node Start node.
2545
2546				Example:
2547
2548
2549				my $s = <
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560				END
2561
2562				ok $a->prettyStringContent eq <
2563
2564
2565
2566
2567
2568
2569
2570
2571				END
2572
2573
2574				=head2 Dense
2575
2576				Print the parse tree.
2577
2578				=head3 string($)
2579
2580				Return a dense string representing a node of a parse tree and all the nodes below it. Or use L<-s\|/opString> $node
2581
2582				1 $node Start node.
2583
2584				Example:
2585
2586
2587				ok -p $x eq <
2588
2589
2590
2591
2592
2593
2594
2595
2596				END
2597
2598				ok -s $x eq '';
2599
2600
2601				=head3 stringQuoted($)
2602
2603				Return a quoted string representing a parse tree a node of a parse tree and all the nodes below it. Or use L<-o\|/opString> $node
2604
2605				1 $node Start node
2606
2607				Example:
2608
2609
2610				my $s = <
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621				END
2622
2623				ok $a->stringQuoted eq q('');
2624
2625
2626				=head3 stringReplacingIdsWithLabels($)
2627
2628				Return a string representing the specified parse tree with the id attribute of each node set to the L attached to each node.
2629
2630				1 $node Start node.
2631
2632				Example:
2633
2634
2635				ok -r $x eq '';
2636
2637				my $s = $x->stringReplacingIdsWithLabels;
2638
2639				ok $s eq '';
2640
2641
2642				=head3 stringContent($)
2643
2644				Return a string representing all the nodes below a node of a parse tree.
2645
2646				1 $node Start node.
2647
2648				Example:
2649
2650
2651				my $s = <
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662				END
2663
2664				ok $a->stringContent eq "";
2665
2666
2667				=head3 stringNode($)
2668
2669				Return a string representing a node showing the attributes, labels and node number
2670
2671				1 $node Node.
2672
2673				Example:
2674
2675
2676				ok -r $x eq '';
2677
2678				$b->addLabels(1..2);
2679
2680				$b->addLabels(3..4);
2681
2682				ok -r $x eq '';
2683
2684				$b->numberTree;
2685
2686				ok -S $b eq "b(2) 0:1 1:2 2:3 3:4";
2687
2688
2689				=head2 Conditions
2690
2691				Print a subset of the the parse tree determined by the conditions attached to it.
2692
2693				=head3 stringWithConditions($@)
2694
2695				Return a string representing a node of a parse tree and all the nodes below it subject to conditions to select or reject some nodes.
2696
2697				1 $node Start node
2698				2 @conditions Conditions to be regarded as in effect.
2699
2700				Example:
2701
2702
2703				my $x = Data::Edit::Xml::new(<
2704
2705
2706
2707
2708				END
2709
2710				my $b = $x >= 'b';
2711
2712				my $c = $x >= 'c';
2713
2714				$b->addConditions(qw(bb BB));
2715
2716				$c->addConditions(qw(cc CC));
2717
2718				ok $x->stringWithConditions eq '';
2719
2720				ok $x->stringWithConditions(qw(bb)) eq '';
2721
2722				ok $x->stringWithConditions(qw(cc)) eq '';
2723
2724
2725				=head3 addConditions($@)
2726
2727				Add conditions to a node and return the node.
2728
2729				1 $node Node
2730				2 @conditions Conditions to add.
2731
2732				Example:
2733
2734
2735				$b->addConditions(qw(bb BB));
2736
2737				ok join(' ', $b->listConditions) eq 'BB bb';
2738
2739
2740				=head3 deleteConditions($@)
2741
2742				Delete conditions applied to a node and return the node.
2743
2744				1 $node Node
2745				2 @conditions Conditions to add.
2746
2747				Example:
2748
2749
2750				ok join(' ', $b->listConditions) eq 'BB bb';
2751
2752				$b->deleteConditions(qw(BB));
2753
2754				ok join(' ', $b->listConditions) eq 'bb';
2755
2756
2757				=head3 listConditions($)
2758
2759				Return a list of conditions applied to a node.
2760
2761				1 $node Node.
2762
2763				Example:
2764
2765
2766				$b->addConditions(qw(bb BB));
2767
2768				ok join(' ', $b->listConditions) eq 'BB bb';
2769
2770
2771				=head1 Attributes
2772
2773				Get or set the attributes of nodes in the parse tree. Well known attributes can be set directly via L B_{s for less well known attributes use L.}
2774
2775				=head2 class :lvalue
2776
2777				Attribute B for a node as an L B_.
2778
2779
2780				=head2 href :lvalue
2781
2782				Attribute B for a node as an L B_.
2783
2784
2785				=head2 id :lvalue
2786
2787				Attribute B for a node as an L B_.
2788
2789
2790				=head2 outputclass :lvalue
2791
2792				Attribute B for a node as an L B_.
2793
2794
2795				=head2 attr :lvalue($$)
2796
2797				Return the value of an attribute of the current node as an L B_.
2798
2799				1 $node Node in parse tree
2800				2 $attribute Attribute name.
2801
2802				=head2 attrs($@)
2803
2804				Return the values of the specified attributes of the current node.
2805
2806				1 $node Node in parse tree
2807				2 @attributes Attribute names.
2808
2809				Example:
2810
2811
2812				ok -s $x eq '';
2813
2814				is_deeply [$x->attrs(qw(third second first ))], [undef, 2, 1];
2815
2816
2817				=head2 attrCount($)
2818
2819				Return the number of attributes in the specified node.
2820
2821				1 $node Node in parse tree
2822
2823				Example:
2824
2825
2826				ok -s $x eq '';
2827
2828				ok $x->attrCount == 3;
2829
2830
2831				=head2 getAttrs($)
2832
2833				Return a sorted list of all the attributes on this node.
2834
2835				1 $node Node in parse tree.
2836
2837				Example:
2838
2839
2840				ok -s $x eq '';
2841
2842				is_deeply [$x->getAttrs], [qw(first number second)];
2843
2844
2845				=head2 setAttr($@)
2846
2847				Set the values of some attributes in a node and return the node.
2848
2849				1 $node Node in parse tree
2850				2 %values (attribute name=>new value)*
2851
2852				Example:
2853
2854
2855				ok -s $x eq '';
2856
2857				$x->setAttr(first=>1, second=>2, last=>undef);
2858
2859				ok -s $x eq '';
2860
2861
2862				=head2 deleteAttr($$$)
2863
2864				Delete the attribute, optionally checking its value first and return the node.
2865
2866				1 $node Node
2867				2 $attr Attribute name
2868				3 $value Optional attribute value to check first.
2869
2870				Example:
2871
2872
2873				ok -s $x eq '';
2874
2875				$x->deleteAttr(qq(delete));
2876
2877				ok -s $x eq '';
2878
2879
2880				=head2 deleteAttrs($@)
2881
2882				Delete any attributes mentioned in a list without checking their values and return the node.
2883
2884				1 $node Node
2885				2 @attrs Attribute name
2886
2887				Example:
2888
2889
2890				ok -s $x eq '';
2891
2892				$x->deleteAttrs(qw(first second third number));
2893
2894				ok -s $x eq '';
2895
2896
2897				=head2 renameAttr($$$)
2898
2899				Change the name of an attribute regardless of whether the new attribute already exists and return the node.
2900
2901				1 $node Node
2902				2 $old Existing attribute name
2903				3 $new New attribute name.
2904
2905				Example:
2906
2907
2908				ok $x->printAttributes eq qq( no="1" word="first");
2909
2910				$x->renameAttr(qw(no number));
2911
2912				ok $x->printAttributes eq qq( number="1" word="first");
2913
2914
2915				=head2 changeAttr($$$)
2916
2917				Change the name of an attribute unless it has already been set and return the node.
2918
2919				1 $node Node
2920				2 $old Existing attribute name
2921				3 $new New attribute name.
2922
2923				Example:
2924
2925
2926				ok $x->printAttributes eq qq( number="1" word="first");
2927
2928				$x->changeAttr(qw(number word));
2929
2930				ok $x->printAttributes eq qq( number="1" word="first");
2931
2932
2933				=head2 renameAttrValue($$$$$)
2934
2935				Change the name and value of an attribute regardless of whether the new attribute already exists and return the node.
2936
2937				1 $node Node
2938				2 $old Existing attribute name
2939				3 $oldValue Existing attribute value
2940				4 $new New attribute name
2941				5 $newValue New attribute value.
2942
2943				Example:
2944
2945
2946				ok $x->printAttributes eq qq( number="1" word="first");
2947
2948				$x->renameAttrValue(qw(number 1 numeral I));
2949
2950				ok $x->printAttributes eq qq( numeral="I" word="first");
2951
2952
2953				=head2 changeAttrValue($$$$$)
2954
2955				Change the name and value of an attribute unless it has already been set and return the node.
2956
2957				1 $node Node
2958				2 $old Existing attribute name
2959				3 $oldValue Existing attribute value
2960				4 $new New attribute name
2961				5 $newValue New attribute value.
2962
2963				Example:
2964
2965
2966				ok $x->printAttributes eq qq( numeral="I" word="first");
2967
2968				$x->changeAttrValue(qw(word second greek mono));
2969
2970				ok $x->printAttributes eq qq( numeral="I" word="first");
2971
2972
2973				=head1 Traversal
2974
2975				Traverse the parse tree in various orders applying a B_{to each node.}
2976
2977				=head2 Post-order
2978
2979				This order allows you to edit children before their parents
2980
2981				=head3 by($$@)
2982
2983				Post-order traversal of a parse tree or sub tree calling the specified B_{at each node and returning the specified starting node. The B_{is passed references to the current node and all of its L. The value of the current node is also made available via B<$_>.}}
2984
2985				1 $node Starting node
2986				2 $sub Sub to call for each sub node
2987				3 @context Accumulated context.
2988
2989				Example:
2990
2991
2992				ok -p $x eq <
2993
2994
2995
2996
2997
2998
2999
3000
3001				END
3002
3003				my $s; $x->by(sub{$s .= $_->tag}); ok $s eq "cbeda"
3004
3005
3006				=head3 byX($$@)
3007
3008				Post-order traversal of a parse tree or sub tree calling the specified B_{within LB<{}> at each node and returning the specified starting node. The B_{is passed references to the current node and all of its L. The value of the current node is also made available via B<$_>.}}
3009
3010				1 $node Starting node
3011				2 $sub Sub to call
3012				3 @context Accumulated context.
3013
3014				Example:
3015
3016
3017				ok -p $x eq <
3018
3019
3020
3021
3022
3023
3024
3025
3026				END
3027
3028				my $s; $x->byX(sub{$s .= $_->tag}); ok $s eq "cbeda"
3029
3030
3031				=head3 byReverse($$@)
3032
3033				Reverse post-order traversal of a parse tree or sub tree calling the specified B_{at each node and returning the specified starting node. The B_{is passed references to the current node and all of its L. The value of the current node is also made available via B<$_>.}}
3034
3035				1 $node Starting node
3036				2 $sub Sub to call for each sub node
3037				3 @context Accumulated context.
3038
3039				Example:
3040
3041
3042				ok -p $x eq <
3043
3044
3045
3046
3047
3048
3049
3050
3051				END
3052
3053				my $s; $x->byReverse(sub{$s .= $_->tag}); ok $s eq "edcba"
3054
3055
3056				=head3 byReverseX($$@)
3057
3058				Reverse post-order traversal of a parse tree or sub tree calling the specified B_{within LB<{}> at each node and returning the specified starting node. The B_{is passed references to the current node and all of its L. The value of the current node is also made available via B<$_>.}}
3059
3060				1 $node Starting node
3061				2 $sub Sub to call for each sub node
3062				3 @context Accumulated context.
3063
3064				Example:
3065
3066
3067				ok -p $x eq <
3068
3069
3070
3071
3072
3073
3074
3075
3076				END
3077
3078				my $s; $x->byReverse(sub{$s .= $_->tag}); ok $s eq "edcba"
3079
3080
3081				=head2 Pre-order
3082
3083				This order allows you to edit children after their parents
3084
3085				=head3 down($$@)
3086
3087				Pre-order traversal down through a parse tree or sub tree calling the specified B_{at each node and returning the specified starting node. The B_{is passed references to the current node and all of its L. The value of the current node is also made available via B<$_>.}}
3088
3089				1 $node Starting node
3090				2 $sub Sub to call for each sub node
3091				3 @context Accumulated context.
3092
3093				Example:
3094
3095
3096				my $s; $x->down(sub{$s .= $_->tag}); ok $s eq "abcde"
3097
3098
3099				=head3 downX($$@)
3100
3101				Pre-order traversal down through a parse tree or sub tree calling the specified B_{within LB<{}> at each node and returning the specified starting node. The B_{is passed references to the current node and all of its L. The value of the current node is also made available via B<$_>.}}
3102
3103				1 $node Starting node
3104				2 $sub Sub to call for each sub node
3105				3 @context Accumulated context.
3106
3107				Example:
3108
3109
3110				my $s; $x->down(sub{$s .= $_->tag}); ok $s eq "abcde"
3111
3112
3113				=head3 downReverse($$@)
3114
3115				Reverse pre-order traversal down through a parse tree or sub tree calling the specified B_{at each node and returning the specified starting node. The B_{is passed references to the current node and all of its L. The value of the current node is also made available via B<$_>.}}
3116
3117				1 $node Starting node
3118				2 $sub Sub to call for each sub node
3119				3 @context Accumulated context.
3120
3121				Example:
3122
3123
3124				ok -p $x eq <
3125
3126
3127
3128
3129
3130
3131
3132
3133				END
3134
3135				my $s; $x->downReverse(sub{$s .= $_->tag}); ok $s eq "adebc"
3136
3137
3138				=head3 downReverseX($$@)
3139
3140				Reverse pre-order traversal down through a parse tree or sub tree calling the specified B_{within LB<{}> at each node and returning the specified starting node. The B_{is passed references to the current node and all of its L. The value of the current node is also made available via B<$_>.}}
3141
3142				1 $node Starting node
3143				2 $sub Sub to call for each sub node
3144				3 @context Accumulated context.
3145
3146				Example:
3147
3148
3149				ok -p $x eq <
3150
3151
3152
3153
3154
3155
3156
3157
3158				END
3159
3160				my $s; $x->downReverse(sub{$s .= $_->tag}); ok $s eq "adebc"
3161
3162
3163				=head2 Pre and Post order
3164
3165				Visit the parent first, then the children, then the parent again.
3166
3167				=head3 through($$$@)
3168
3169				Traverse parse tree visiting each node twice calling the specified B_{at each node and returning the specified starting node. The B_{s are passed references to the current node and all of its L. The value of the current node is also made available via B<$_>.}}
3170
3171				1 $node Starting node
3172				2 $before Sub to call when we meet a node
3173				3 $after Sub to call we leave a node
3174				4 @context Accumulated context.
3175
3176				Example:
3177
3178
3179				my $s; my $n = sub{$s .= $_->tag}; $x->through($n, $n);
3180
3181				ok $s eq "abccbdeeda"
3182
3183
3184				=head3 throughX($$$@)
3185
3186				Traverse parse tree visiting each node twice calling the specified B_{within LB<{}> at each node and returning the specified starting node. The B_{is passed references to the current node and all of its L. The value of the current node is also made available via B<$_>.}}
3187
3188				1 $node Starting node
3189				2 $before Sub to call when we meet a node
3190				3 $after Sub to call we leave a node
3191				4 @context Accumulated context.
3192
3193				Example:
3194
3195
3196				my $s; my $n = sub{$s .= $_->tag}; $x->through($n, $n);
3197
3198				ok $s eq "abccbdeeda"
3199
3200
3201				=head2 Range
3202
3203				Ranges of nodes
3204
3205				=head3 from($@)
3206
3207				Return a list consisting of the specified node and its following siblings optionally including only those nodes that match the specified context
3208
3209				1 $start Start node
3210				2 @context Optional context
3211
3212				Example:
3213
3214
3215				ok -z $a eq <
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239				END
3240
3241				my ($d, $c, $D) = $a->findByNumbers(5, 7, 10);
3242
3243				my @f = $d->from;
3244
3245				ok @f == 4;
3246
3247				ok $d == $f[0];
3248
3249				my @F = $d->from(qw(c));
3250
3251				ok @F == 2;
3252
3253				ok -M $F[1] == 12;
3254
3255				ok $D == $t[-1];
3256
3257
3258				=head3 to($@)
3259
3260				Return a list of the siblings preceding the specified node and the specified node at optionally optionally including only those nodes that match the specified context
3261
3262				1 $end End node
3263				2 @context Optional context
3264
3265				Example:
3266
3267
3268				ok -z $a eq <
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292				END
3293
3294				my ($d, $c, $D) = $a->findByNumbers(5, 7, 10);
3295
3296				my @t = $D->to;
3297
3298				ok @t == 4;
3299
3300				my @T = $D->to(qw(c));
3301
3302				ok @T == 2;
3303
3304				ok -M $T[1] == 7;
3305
3306
3307				=head3 range($$@)
3308
3309				Return a list of the nodes between the specified start node and end node that optionally match the specified context.
3310
3311				1 $start Start node
3312				2 $end End node
3313				3 @context Optional context
3314
3315				Example:
3316
3317
3318				ok -z $a eq <
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342				END
3343
3344				my ($d, $c, $D) = $a->findByNumbers(5, 7, 10);
3345
3346				my @r = $d->range($D);
3347
3348				ok @r == 3;
3349
3350				my @R = $d->range($D, qw(c));
3351
3352				ok @R == 1;
3353
3354				ok -M $R[0] == 7;
3355
3356				ok !$D->range($d);
3357
3358				ok 1 == $d->range($d);
3359
3360
3361				=head1 Position
3362
3363				Confirm that the position L to is the expected position.
3364
3365				=head2 at($@)
3366
3367				Confirm that the node has the specified L and return the starting node if it does else B. Ancestry is specified by providing the expected tag sof the parent, the parent's parent etc. If B is specified as a parent's tag then any tag is assumed to match.
3368
3369				1 $start Starting node
3370				2 @context Ancestry.
3371
3372				Example:
3373
3374
3375				my $a = Data::Edit::Xml::new(<
3376
3377
3378
3379
3380
3381
3382
3383				END
3384
3385				ok $a->go(qw(b c -1 f))->at(qw(f c b a));
3386
3387				ok $a->go(qw(b c 1 e))->at(undef, qq(c), undef, qq(a));
3388
3389				ok $a->go(qw(b c d)) ->at(qw(d c b), undef);
3390
3391				ok !$a->go(qw(b c d)) ->at(qw(d c b), undef, undef);
3392
3393				ok !$a->go(qw(b c d)) ->at(qw(d e b));
3394
3395
3396				Use B to execute L but B 'at' instead of returning B
3397
3398				=head2 ancestry($)
3399
3400				Return a list containing: (the specified node, its parent, its parent's parent etc..)
3401
3402				1 $start Starting node.
3403
3404				Example:
3405
3406
3407				$a->numberTree;
3408
3409				ok $a->prettyStringNumbered eq <
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420				END
3421
3422				is_deeply [map {-t $_} $a->findByNumber(7)->ancestry], [qw(D c a)];
3423
3424
3425				=head2 context($)
3426
3427				Return a string containing the tag of the starting node and the tags of all its ancestors separated by single spaces.
3428
3429				1 $start Starting node.
3430
3431				Example:
3432
3433
3434				ok -p $x eq <
3435
3436
3437
3438
3439
3440
3441
3442
3443				END
3444
3445				ok $x->go(qw(d e))->context eq 'e d a';
3446
3447
3448				=head2 containsSingleText($)
3449
3450				Return the singleton text element below this node else return B
3451
3452				1 $node Node.
3453
3454				Example:
3455
3456
3457				if (1)
3458
3459				ok $a->go(qw(b))->containsSingleText->text eq q(bb);
3460
3461				ok !$a->go(qw(c))->containsSingleText;
3462
3463
3464				=head2 depth($)
3465
3466				Returns the depth of the specified node, the depth of a root node is zero.
3467
3468				1 $node Node.
3469
3470				Example:
3471
3472
3473				ok -z $a eq <
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497				END
3498
3499				ok 0 == $a->depth;
3500
3501				ok 4 == $a->findByNumber(14)->depth;
3502
3503
3504				=head2 isFirst($)
3505
3506				Confirm that this node is the first node under its parent.
3507
3508				1 $node Node.
3509
3510				Example:
3511
3512
3513				ok -p $x eq <
3514
3515
3516
3517
3518
3519
3520
3521
3522				END
3523
3524				ok $x->go(qw(b))->isFirst;
3525
3526
3527				Use B to execute L but B 'isFirst' instead of returning B
3528
3529				=head2 isLast($)
3530
3531				Confirm that this node is the last node under its parent.
3532
3533				1 $node Node.
3534
3535				Example:
3536
3537
3538				ok -p $x eq <
3539
3540
3541
3542
3543
3544
3545
3546
3547				END
3548
3549				ok $x->go(qw(d))->isLast;
3550
3551
3552				Use B to execute L but B 'isLast' instead of returning B
3553
3554				=head2 isOnlyChild($@)
3555
3556				Return the specified node if it is the only node under its parent (and ancestors) ignoring any surrounding blank text.
3557
3558				1 $node Node
3559				2 @tags Optional tags to confirm context.
3560
3561				Example:
3562
3563
3564				my $x = Data::Edit::Xml::new(<first->first;
3565
3566				END
3567
3568				ok $x->isOnlyChild;
3569
3570				ok $x->isOnlyChild(qw(c));
3571
3572				ok $x->isOnlyChild(qw(c b));
3573
3574				ok $x->isOnlyChild(qw(c b a));
3575
3576
3577				Use B to execute L but B 'isOnlyChild' instead of returning B
3578
3579				=head2 isEmpty($)
3580
3581				Confirm that this node is empty, that is: this node has no content, not even a blank string of text.
3582
3583				1 $node Node.
3584
3585				Example:
3586
3587
3588				my $x = Data::Edit::Xml::new(<
3589
3590
3591
3592				END
3593
3594				ok $x->isEmpty;
3595
3596				my $x = Data::Edit::Xml::new(<first->first;
3597
3598				END
3599
3600				ok $x->isEmpty;
3601
3602
3603				Use B to execute L but B 'isEmpty' instead of returning B
3604
3605				=head2 over($$)
3606
3607				Confirm that the string representing the tags at the level below this node match a regular expression.
3608
3609				1 $node Node
3610				2 $re Regular expression.
3611
3612				Example:
3613
3614
3615				my $x = Data::Edit::Xml::new(<
3616
3617
3618
3619
3620
3621				END
3622
3623				ok $x->go(qw(b))->over(qr(d.+e));
3624
3625
3626				Use B to execute L but B 'over' instead of returning B
3627
3628				=head2 matchAfter($$)
3629
3630				Confirm that the string representing the tags following this node matches a regular expression.
3631
3632				1 $node Node
3633				2 $re Regular expression.
3634
3635				Example:
3636
3637
3638				my $x = Data::Edit::Xml::new(<
3639
3640
3641
3642
3643
3644				END
3645
3646				ok $x->go(qw(b e))->matchAfter (qr(\Af g\Z));
3647
3648
3649				Use B to execute L but B 'matchAfter' instead of returning B
3650
3651				=head2 matchBefore($$)
3652
3653				Confirm that the string representing the tags preceding this node matches a regular expression
3654
3655				1 $node Node
3656				2 $re Regular expression
3657
3658				Example:
3659
3660
3661				my $x = Data::Edit::Xml::new(<
3662
3663
3664
3665
3666
3667				END
3668
3669				ok $x->go(qw(b e))->matchBefore(qr(\Ac d\Z));
3670
3671
3672				Use B to execute L but B 'matchBefore' instead of returning B
3673
3674				=head2 path($)
3675
3676				Return a list representing the path to a node which can then be reused by L to retrieve the node as long as the structure of the parse tree has not changed along the path.
3677
3678				1 $node Node.
3679
3680				Example:
3681
3682
3683				my $x = Data::Edit::Xml::new(<
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700				END
3701
3702				is_deeply [$x->go(qw(b d 1 e))->path], [qw(b d 1 e)];
3703
3704				$x->by(sub {ok $x->go($_->path) == $_});
3705
3706
3707				=head2 pathString($)
3708
3709				Return a string representing the L to a node
3710
3711				1 $node Node.
3712
3713				Example:
3714
3715
3716				ok -z $a eq <
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740				END
3741
3742				ok $a->findByNumber(9)->pathString eq 'b c 1 d e';
3743
3744
3745				=head1 Navigation
3746
3747				Move around in the parse tree
3748
3749				=head2 go($@)
3750
3751				Return the node reached from the specified node via the specified L: (index positionB)B<> where index is the tag of the next node to be chosen and position is the optional zero based position within the index of those tags under the current node. Position defaults to zero if not specified. Position can also be negative to index back from the top of the index array. B<> can be used as the last position to retrieve all nodes with the final tag.
3752
3753				1 $node Node
3754				2 @position Search specification.
3755
3756				Example:
3757
3758
3759				my $x = Data::Edit::Xml::new(my $s = <
3760
3761
3762
3763
3764
3765
3766
3767				END
3768
3769				ok $x->go(qw(a c)) ->id == 1;
3770
3771				ok $x->go(qw(a c -2))->id == 3;
3772
3773				ok $x->go(qw(a c *)) == 4;
3774
3775				ok 1234 == join '', map {$_->id} $x->go(qw(a c *));
3776
3777
3778				Use B to execute L but B 'go' instead of returning B
3779
3780				=head2 c($$)
3781
3782				Return an array of all the nodes with the specified tag below the specified node.
3783
3784				1 $node Node
3785				2 $tag Tag.
3786
3787				Example:
3788
3789
3790				my $x = Data::Edit::Xml::new(<
3791
3792
3793
3794
3795
3796
3797
3798
3799				END
3800
3801				is_deeply [map{-u $_} $x->c(q(d))], [qw(d1 d2)];
3802
3803
3804				=head2 First
3805
3806				Find nodes that are first amongst their siblings.
3807
3808				=head3 first($@)
3809
3810				Return the first node below this node optionally checking its context.
3811
3812				1 $node Node
3813				2 @context Optional context.
3814
3815				Use B to skip a (rare) initial blank text CDATA. Use B to die rather
3816				then receive a returned B or false result.
3817
3818
3819
3820				Example:
3821
3822
3823				my $a = Data::Edit::Xml::new(<
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852				END
3853
3854				ok $a->go(qw(b))->first->id == 13;
3855
3856				ok $a->go(qw(b))->first(qw(c b a));
3857
3858				ok !$a->go(qw(b))->first(qw(b a));
3859
3860
3861				Use B to execute L but B 'first' instead of returning B
3862
3863				=head3 firstBy($@)
3864
3865				Return a list of the first instance of each specified tag encountered in a post-order traversal from the specified node or a hash of all first instances if no tags are specified.
3866
3867				1 $node Node
3868				2 @tags Tags to search for.
3869
3870				Example:
3871
3872
3873				my $a = Data::Edit::Xml::new(<
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902				END
3903
3904				my %f = $a->firstBy;
3905
3906				ok $f{b}->id == 12;
3907
3908
3909				=head3 firstDown($@)
3910
3911				Return a list of the first instance of each specified tag encountered in a pre-order traversal from the specified node or a hash of all first instances if no tags are specified.
3912
3913				1 $node Node
3914				2 @tags Tags to search for.
3915
3916				Example:
3917
3918
3919				my %f = $a->firstDown;
3920
3921				ok $f{b}->id == 15;
3922
3923
3924				=head3 firstIn($@)
3925
3926				Return the first node matching one of the named tags under the specified node.
3927
3928				1 $node Node
3929				2 @tags Tags to search for.
3930
3931				Example:
3932
3933
3934				ok $a->prettyStringCDATA eq <<'END';
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945				END
3946
3947				ok $a->firstIn(qw(b B c C))->tag eq qq(C);
3948
3949
3950				Use B to execute L but B 'firstIn' instead of returning B
3951
3952				=head3 firstInIndex($@)
3953
3954				Return the specified node if it is first in its index and optionally L the specified context else B
3955
3956				1 $node Node
3957				2 @context Optional context.
3958
3959				Example:
3960
3961
3962				ok -z $a eq <
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986				END
3987
3988				ok $a->findByNumber (5)->firstInIndex;
3989
3990				ok !$a->findByNumber(7) ->firstInIndex;
3991
3992
3993				Use B to execute L but B 'firstInIndex' instead of returning B
3994
3995				=head3 firstContextOf($@)
3996
3997				Return the first node encountered in the specified context in a depth first post-order traversal of the parse tree.
3998
3999				1 $node Node
4000				2 @context Array of tags specifying context.
4001
4002				Example:
4003
4004
4005				my $x = Data::Edit::Xml::new(<
4006
4007
4008
4009				DD11
4010				EE11
4011
4012
4013
4014
4015				DD22
4016				EE22
4017
4018
4019
4020
4021				DD33
4022				EE33
4023
4024
4025
4026				END
4027
4028				ok $x->firstContextOf(qw(d c)) ->id eq qq(d1);
4029
4030				ok $x->firstContextOf(qw(e c b2)) ->id eq qq(e2);
4031
4032				ok $x->firstContextOf(qw(CDATA d c b2))->string eq qq(DD22);
4033
4034
4035				Use B to execute L but B 'firstContextOf' instead of returning B
4036
4037				=head2 Last
4038
4039				Find nodes that are last amongst their siblings.
4040
4041				=head3 last($@)
4042
4043				Return the last node below this node optionally checking its context.
4044
4045				1 $node Node
4046				2 @context Optional context.
4047
4048				Use B to skip a (rare) initial blank text CDATA. Use B to die rather
4049				then receive a returned B or false result.
4050
4051
4052
4053				Example:
4054
4055
4056				my $a = Data::Edit::Xml::new(<
4057
4058
4059
4060
4061
4062
4063
4064
4065
4066
4067
4068
4069
4070
4071
4072
4073
4074
4075
4076
4077
4078
4079
4080
4081
4082
4083
4084
4085				END
4086
4087				ok $a->go(qw(b))->last ->id == 22;
4088
4089				ok $a->go(qw(b))->last(qw(g b a));
4090
4091				ok !$a->go(qw(b))->last(qw(b a));
4092
4093
4094				Use B to execute L but B 'last' instead of returning B
4095
4096				=head3 lastBy($@)
4097
4098				Return a list of the last instance of each specified tag encountered in a post-order traversal from the specified node or a hash of all first instances if no tags are specified.
4099
4100				1 $node Node
4101				2 @tags Tags to search for.
4102
4103				Example:
4104
4105
4106				my $a = Data::Edit::Xml::new(<
4107
4108
4109
4110
4111
4112
4113
4114
4115
4116
4117
4118
4119
4120
4121
4122
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135				END
4136
4137				my %l = $a->lastBy;
4138
4139				ok $l{b}->id == 23;
4140
4141
4142				=head3 lastDown($@)
4143
4144				Return a list of the last instance of each specified tag encountered in a pre-order traversal from the specified node or a hash of all first instances if no tags are specified.
4145
4146				1 $node Node
4147				2 @tags Tags to search for.
4148
4149				Example:
4150
4151
4152				my %l = $a->lastDown;
4153
4154				ok $l{b}->id == 26;
4155
4156
4157				=head3 lastIn($@)
4158
4159				Return the first node matching one of the named tags under the specified node.
4160
4161				1 $node Node
4162				2 @tags Tags to search for.
4163
4164				Example:
4165
4166
4167				ok $a->prettyStringCDATA eq <<'END';
4168
4169
4170
4171
4172
4173
4174
4175
4176
4177
4178				END
4179
4180				ok $a->lastIn(qw(e E f F))->tag eq qq(E);
4181
4182
4183				Use B to execute L but B 'lastIn' instead of returning B
4184
4185				=head3 lastInIndex($@)
4186
4187				Return the specified node if it is last in its index and optionally L the specified context else B
4188
4189				1 $node Node
4190				2 @context Optional context.
4191
4192				Example:
4193
4194
4195				ok -z $a eq <
4196
4197
4198
4199
4200
4201
4202
4203
4204
4205
4206
4207
4208
4209
4210
4211
4212
4213
4214
4215
4216
4217
4218
4219				END
4220
4221				ok $a->findByNumber(10)->lastInIndex;
4222
4223				ok !$a->findByNumber(7) ->lastInIndex;
4224
4225
4226				Use B to execute L but B 'lastInIndex' instead of returning B
4227
4228				=head3 lastContextOf($@)
4229
4230				Return the last node encountered in the specified context in a depth first reverse pre-order traversal of the parse tree.
4231
4232				1 $node Node
4233				2 @context Array of tags specifying context.
4234
4235				Example:
4236
4237
4238				my $x = Data::Edit::Xml::new(<
4239
4240
4241
4242				DD11
4243				EE11
4244
4245
4246
4247
4248				DD22
4249				EE22
4250
4251
4252
4253
4254				DD33
4255				EE33
4256
4257
4258
4259				END
4260
4261				ok $x-> lastContextOf(qw(d c)) ->id eq qq(d3);
4262
4263				ok $x-> lastContextOf(qw(e c b2 )) ->id eq qq(e2);
4264
4265				ok $x-> lastContextOf(qw(CDATA e c b2))->string eq qq(EE22);
4266
4267
4268				Use B to execute L but B 'lastContextOf' instead of returning B
4269
4270				=head2 Next
4271
4272				Find sibling nodes after the specified node.
4273
4274				=head3 next($@)
4275
4276				Return the node next to the specified node, optionally checking its context.
4277
4278				1 $node Node
4279				2 @context Optional context.
4280
4281				Use B to skip a (rare) initial blank text CDATA. Use B to die rather
4282				then receive a returned B or false result.
4283
4284
4285
4286				Example:
4287
4288
4289				my $a = Data::Edit::Xml::new(<
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
4300
4301
4302
4303
4304
4305
4306
4307
4308
4309
4310
4311
4312
4313
4314
4315
4316
4317
4318				END
4319
4320				ok $a->go(qw(b b e))->next ->id == 19;
4321
4322				ok $a->go(qw(b b e))->next(qw(f b b a));
4323
4324				ok !$a->go(qw(b b e))->next(qw(f b a));
4325
4326
4327				Use B to execute L but B 'next' instead of returning B
4328
4329				=head3 nextIn($@)
4330
4331				Return the next node matching one of the named tags.
4332
4333				1 $node Node
4334				2 @tags Tags to search for.
4335
4336				Example:
4337
4338
4339				ok $a->prettyStringCDATA eq <<'END';
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350				END
4351
4352				ok $a->firstIn(qw(b B c C))->nextIn(qw(A G))->tag eq qq(G);
4353
4354
4355				Use B to execute L but B 'nextIn' instead of returning B
4356
4357				=head3 nextOn($@)
4358
4359				Step forwards as far as possible while remaining on nodes with the specified tags and return the last such node reached or the starting node if no such steps are possible.
4360
4361				1 $node Start node
4362				2 @tags Tags identifying nodes that can be step on to context.
4363
4364				Example:
4365
4366
4367				ok -p $a eq <
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377				END
4378
4379				ok $c->id == 1;
4380
4381				ok $c->nextOn(qw(d)) ->id == 2;
4382
4383				ok $c->nextOn(qw(c d))->id == 4;
4384
4385				ok $e->nextOn(qw(c d)) == $e;
4386
4387
4388				=head2 Prev
4389
4390				Find sibling nodes before the specified node.
4391
4392				=head3 prev($@)
4393
4394				Return the node before the specified node, optionally checking its context.
4395
4396				1 $node Node
4397				2 @context Optional context.
4398
4399				Use B to skip a (rare) initial blank text CDATA. Use B to die rather
4400				then receive a returned B or false result.
4401
4402
4403
4404				Example:
4405
4406
4407				my $a = Data::Edit::Xml::new(<
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436				END
4437
4438				ok $a->go(qw(b b e))->prev ->id == 17;
4439
4440				ok $a->go(qw(b b e))->prev(qw(d b b a));
4441
4442				ok !$a->go(qw(b b e))->prev(qw(d b a));
4443
4444
4445				Use B to execute L but B 'prev' instead of returning B
4446
4447				=head3 prevIn($@)
4448
4449				Return the next previous node matching one of the named tags.
4450
4451				1 $node Node
4452				2 @tags Tags to search for.
4453
4454				Example:
4455
4456
4457				ok $a->prettyStringCDATA eq <<'END';
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468				END
4469
4470				ok $a->lastIn(qw(e E f F))->prevIn(qw(A G))->tag eq qq(A);
4471
4472
4473				Use B to execute L but B 'prevIn' instead of returning B
4474
4475				=head3 prevOn($@)
4476
4477				Step backwards as far as possible while remaining on nodes with the specified tags and return the last such node reached or the starting node if no such steps are possible.
4478
4479				1 $node Start node
4480				2 @tags Tags identifying nodes that can be step on to context.
4481
4482				Example:
4483
4484
4485				ok -p $a eq <
4486
4487
4488
4489
4490
4491
4492
4493
4494
4495				END
4496
4497				ok $c->id == 1;
4498
4499				ok $e->id == 5;
4500
4501				ok $e->prevOn(qw(d)) ->id == 4;
4502
4503				ok $e->prevOn(qw(c d)) == $c;
4504
4505
4506				=head2 Upto
4507
4508				Methods for moving up the parse tree from a node.
4509
4510				=head3 upto($@)
4511
4512				Return the first ancestral node that matches the specified context.
4513
4514				1 $node Start node
4515				2 @tags Tags identifying context.
4516
4517				Example:
4518
4519
4520				$a->numberTree;
4521
4522				ok -z $a eq <
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538				END
4539
4540				ok $a->findByNumber(8)->upto(qw(b c))->number == 4;
4541
4542
4543				Use B to execute L but B 'upto' instead of returning B
4544
4545				=head1 Editing
4546
4547				Edit the data in the parse tree and change the structure of the parse tree by L nodes, by L nodes, by L nodes, by L nodes, by L nodes or by adding node as L
4548
4549				=head2 change($$@)
4550
4551				Change the name of a node, optionally confirming that the node is in a specified context and return the node.
4552
4553				1 $node Node
4554				2 $name New name
4555				3 @tags Optional: tags defining the required context.
4556
4557				Example:
4558
4559
4560				my $a = Data::Edit::Xml::new('');
4561
4562				$a->change(qq(b));
4563
4564				ok -s $a eq '';
4565
4566
4567				Use B to execute L but B 'change' instead of returning B
4568
4569				=head2 Cut and Put
4570
4571				Move nodes around in the parse tree by cutting and pasting them
4572
4573				=head3 cut($)
4574
4575				Cut out a node so that it can be reinserted else where in the parse tree.
4576
4577				1 $node Node to cut out.
4578
4579				Example:
4580
4581
4582				ok -p $a eq <
4583
4584
4585
4586
4587
4588				END
4589
4590				my $c = $a->go(qw(b c))->cut;
4591
4592				ok -p $a eq <
4593
4594
4595
4596				END
4597
4598
4599				=head3 putFirst($$)
4600
4601				Place a L at the front of the content of the specified node and return the new node.
4602
4603				1 $old Original node
4604				2 $new New node.
4605
4606				Example:
4607
4608
4609				ok -p $a eq <
4610
4611
4612
4613
4614
4615				END
4616
4617				my $c = $a->go(qw(b c))->cut;
4618
4619				$a->putFirst($c);
4620
4621				ok -p $a eq <
4622
4623
4624
4625
4626				END
4627
4628
4629				=head3 putLast($$)
4630
4631				Place a L last in the content of the specified node and return the new node.
4632
4633				1 $old Original node
4634				2 $new New node.
4635
4636				Example:
4637
4638
4639				ok -p $a eq <
4640
4641
4642
4643
4644				END
4645
4646				$a->putLast($a->go(qw(c))->cut);
4647
4648				ok -p $a eq <
4649
4650
4651
4652
4653				END
4654
4655
4656				=head3 putNext($$)
4657
4658				Place a L just after the specified node and return the new node.
4659
4660				1 $old Original node
4661				2 $new New node.
4662
4663				Example:
4664
4665
4666				ok -p $a eq <
4667
4668
4669
4670
4671				END
4672
4673				$a->go(qw(c))->putNext($a->go(qw(b))->cut);
4674
4675				ok -p $a eq <
4676
4677
4678
4679
4680				END
4681
4682
4683				=head3 putPrev($$)
4684
4685				Place a L just before the specified node and return the new node.
4686
4687				1 $old Original node
4688				2 $new New node.
4689
4690				Example:
4691
4692
4693				ok -p $a eq <
4694
4695
4696
4697
4698				END
4699
4700				$a->go(qw(c))->putPrev($a->go(qw(b))->cut);
4701
4702				ok -p $a eq <
4703
4704
4705
4706
4707				END
4708
4709
4710				=head2 Fusion
4711
4712				Join consecutive nodes
4713
4714				=head3 concatenate($$)
4715
4716				Concatenate two successive nodes and return the target node.
4717
4718				1 $target Target node to replace
4719				2 $source Node to concatenate.
4720
4721				Example:
4722
4723
4724				my $s = <
4725
4726
4727
4728
4729
4730
4731
4732
4733
4734
4735				END
4736
4737				my $a = Data::Edit::Xml::new($s);
4738
4739				$a->go(qw(b))->concatenate($a->go(qw(c)));
4740
4741				my $t = <
4742
4743
4744
4745
4746
4747
4748
4749
4750				END
4751
4752				ok $t eq -p $a;
4753
4754
4755				=head3 concatenateSiblings($)
4756
4757				Concatenate preceding and following nodes as long as they have the same tag as the specified node and return the specified node.
4758
4759				1 $node Concatenate around this node.
4760
4761				Example:
4762
4763
4764				ok -p $a eq <
4765
4766
4767
4768
4769
4770
4771
4772
4773
4774
4775
4776
4777
4778
4779				END
4780
4781				$a->go(qw(b 3))->concatenateSiblings;
4782
4783				ok -p $a eq <
4784
4785
4786
4787
4788
4789
4790
4791
4792				END
4793
4794
4795				=head2 Put as text
4796
4797				Add text to the parse tree.
4798
4799				=head3 putFirstAsText($$)
4800
4801				Add a new text node first under a parent and return the new text node.
4802
4803				1 $node The parent node
4804				2 $text The string to be added which might contain unparsed Xml as well as text.
4805
4806				Example:
4807
4808
4809				ok -p $x eq <
4810
4811
4812
4813
4814
4815				END
4816
4817				$x->go(qw(b c))->putFirstAsText("DDDD");
4818
4819				ok -p $x eq <
4820
4821
4822				DDDD
4823
4824
4825				END
4826
4827
4828				=head3 putLastAsText($$)
4829
4830				Add a new text node last under a parent and return the new text node.
4831
4832				1 $node The parent node
4833				2 $text The string to be added which might contain unparsed Xml as well as text.
4834
4835				Example:
4836
4837
4838				ok -p $x eq <
4839
4840
4841				DDDD
4842
4843
4844				END
4845
4846				$x->go(qw(b c))->putLastAsText("EEEE");
4847
4848				ok -p $x eq <
4849
4850
4851				DDDDEEEE
4852
4853
4854				END
4855
4856
4857				=head3 putNextAsText($$)
4858
4859				Add a new text node following this node and return the new text node.
4860
4861				1 $node The parent node
4862				2 $text The string to be added which might contain unparsed Xml as well as text.
4863
4864				Example:
4865
4866
4867				ok -p $x eq <
4868
4869
4870				DDDDEEEE
4871
4872
4873				END
4874
4875				$x->go(qw(b c))->putNextAsText("NNNN");
4876
4877				ok -p $x eq <
4878
4879
4880				DDDDEEEE
4881				NNNN
4882
4883
4884				END
4885
4886
4887				=head3 putPrevAsText($$)
4888
4889				Add a new text node following this node and return the new text node
4890
4891				1 $node The parent node
4892				2 $text The string to be added which might contain unparsed Xml as well as text
4893
4894				Example:
4895
4896
4897				ok -p $x eq <
4898
4899
4900				DDDDEEEE
4901				NNNN
4902
4903
4904				END
4905
4906				$x->go(qw(b c))->putPrevAsText(" PPPP ");
4907
4908				ok -p $x eq <
4909
4910				PPPP
4911				DDDDEEEE
4912				NNNN
4913
4914
4915				END
4916
4917
4918				=head2 Break in and out
4919
4920				Break nodes out of nodes or push them back
4921
4922				=head3 breakIn($)
4923
4924				Concatenate the nodes following and preceding the start node, unwrapping nodes whose tag matches the start node and return the start node. To concatenate only the preceding nodes, use L, to concatenate only the following nodes, use L.
4925
4926				1 $start The start node.
4927
4928				Example:
4929
4930
4931				ok -p $a eq <
4932
4933
4934
4935
4936
4937
4938
4939
4940
4941
4942
4943
4944
4945				END
4946
4947				$a->go(qw(b 1))->breakIn;
4948
4949				ok -p $a eq <
4950
4951
4952
4953
4954
4955
4956
4957
4958
4959
4960
4961				END
4962
4963
4964				=head3 breakInForwards($)
4965
4966				Concatenate the nodes following the start node, unwrapping nodes whose tag matches the start node and return the start node in the manner of L.
4967
4968				1 $start The start node.
4969
4970				Example:
4971
4972
4973				ok -p $a eq <
4974
4975
4976
4977
4978
4979
4980
4981
4982
4983
4984
4985
4986
4987				END
4988
4989				$a->go(qw(b))->breakInForwards;
4990
4991				ok -p $a eq <
4992
4993
4994
4995
4996
4997
4998
4999
5000
5001
5002
5003				END
5004
5005
5006				=head3 breakInBackwards($)
5007
5008				Concatenate the nodes preceding the start node, unwrapping nodes whose tag matches the start node and return the start node in the manner of L.
5009
5010				1 $start The start node.
5011
5012				Example:
5013
5014
5015				ok -p $a eq <
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025
5026
5027
5028
5029				END
5030
5031				$a->go(qw(b 1))->breakInBackwards;
5032
5033				ok -p $a eq <
5034
5035
5036
5037
5038
5039
5040
5041
5042
5043
5044
5045				END
5046
5047
5048				=head3 breakOut($@)
5049
5050				Lift child nodes with the specified tags under the specified parent node splitting the parent node into clones and return the cut out original node.
5051
5052				1 $parent The parent node
5053				2 @tags The tags of the modes to be broken out.
5054
5055				Example:
5056
5057
5058				my $A = Data::Edit::Xml::new("");
5059
5060				$a->go(qw(b))->breakOut($a, qw(d e));
5061
5062				ok -p $a eq <
5063
5064
5065
5066
5067
5068
5069
5070
5071
5072
5073
5074
5075
5076				END
5077
5078
5079				=head2 Replace
5080
5081				Replace nodes in the parse tree with nodes or text
5082
5083				=head3 replaceWith($$)
5084
5085				Replace a node (and all its content) with a L (and all its content) and return the new node.
5086
5087				1 $old Old node
5088				2 $new New node.
5089
5090				Example:
5091
5092
5093				my $x = Data::Edit::Xml::new(qq());
5094
5095				$x->go(qw(b c))->replaceWith($x->newTag(qw(d id dd)));
5096
5097				ok -s $x eq '';
5098
5099
5100				=head3 replaceWithText($$)
5101
5102				Replace a node (and all its content) with a new text node and return the new node.
5103
5104				1 $old Old node
5105				2 $text Text of new node.
5106
5107				Example:
5108
5109
5110				my $x = Data::Edit::Xml::new(qq());
5111
5112				$x->go(qw(b c))->replaceWithText(qq(BBBB));
5113
5114				ok -s $x eq 'BBBB';
5115
5116
5117				=head3 replaceWithBlank($)
5118
5119				Replace a node (and all its content) with a new blank text node and return the new node.
5120
5121				1 $old Old node
5122
5123				Example:
5124
5125
5126				my $x = Data::Edit::Xml::new(qq());
5127
5128				$x->go(qw(b c))->replaceWithBlank;
5129
5130				ok -s $x eq ' ';
5131
5132
5133				=head2 Wrap and unwrap
5134
5135				Wrap and unwrap nodes to alter the depth of the parse tree
5136
5137				=head3 wrapWith($$@)
5138
5139				Wrap the original node in a new node forcing the original node down deepening the parse tree; return the new wrapping node.
5140
5141				1 $old Node
5142				2 $tag Tag for the L
5143				3 %attributes Attributes for the L.
5144
5145				Example:
5146
5147
5148				ok -p $x eq <
5149
5150
5151
5152
5153
5154				END
5155
5156				$x->go(qw(b c))->wrapWith(qw(C id 1));
5157
5158				ok -p $x eq <
5159
5160
5161
5162
5163
5164
5165
5166				END
5167
5168
5169				=head3 wrapUp($@)
5170
5171				Wrap the original node in a sequence of new nodes forcing the original node down deepening the parse tree; return the array of wrapping nodes.
5172
5173				1 $node Node to wrap
5174				2 @tags Tags to wrap the node with - with the uppermost tag rightmost.
5175
5176				Example:
5177
5178
5179				my $c = Data::Edit::Xml::newTree("c", id=>33);
5180
5181				my ($b, $a) = $c->wrapUp(qw(b a));
5182
5183				ok -p $a eq <<'END';
5184
5185
5186
5187
5188
5189				END
5190
5191
5192				=head3 wrapDown($@)
5193
5194				Wrap the content of the specified node in a sequence of new nodes forcing the original node up deepening the parse tree; return the array of wrapping nodes.
5195
5196				1 $node Node to wrap
5197				2 @tags Tags to wrap the node with - with the uppermost tag rightmost.
5198
5199				Example:
5200
5201
5202				my $a = Data::Edit::Xml::newTree("a", id=>33);
5203
5204				my ($b, $c) = $a->wrapDown(qw(b c));
5205
5206				ok -p $a eq <
5207
5208
5209
5210
5211
5212				END
5213
5214
5215				=head3 wrapContentWith($$@)
5216
5217				Wrap the content of a node in a new node, the original content then contains the new node which contains the original node's content; returns the new wrapped node.
5218
5219				1 $old Node
5220				2 $tag Tag for new node
5221				3 %attributes Attributes for new node.
5222
5223				Example:
5224
5225
5226				ok -p $x eq <
5227
5228
5229
5230
5231
5232
5233
5234				END
5235
5236				$x->go(qw(b))->wrapContentWith(qw(D id DD));
5237
5238				ok -p $x eq <
5239
5240
5241
5242
5243
5244
5245
5246
5247
5248				END
5249
5250
5251				=head3 wrapTo($$$@)
5252
5253				Wrap all the nodes starting and ending at the specified nodes with a new node with the specified tag and attributes and return the new node. Return B if the start and end nodes are not siblings - they must have the same parent for this method to work.
5254
5255				1 $start Start node
5256				2 $end End node
5257				3 $tag Tag for the wrapping node
5258				4 %attributes Attributes for the wrapping node
5259
5260				Example:
5261
5262
5263				my $x = Data::Edit::Xml::new(my $s = <
5264
5265
5266
5267
5268
5269
5270
5271				END
5272
5273				$x->go(qw(a c))->wrapTo($x->go(qw(a c -1)), qq(C), id=>1234);
5274
5275				ok -p $x eq <
5276
5277
5278
5279
5280
5281
5282
5283
5284
5285
5286
5287
5288				END
5289
5290
5291				Use B to execute L but B 'wrapTo' instead of returning B
5292
5293				=head3 unwrap($)
5294
5295				Unwrap a node by inserting its content into its parent at the point containing the node and return the parent node.
5296
5297				1 $node Node to unwrap.
5298
5299				Example:
5300
5301
5302				ok -s $x eq "A c B";
5303
5304				$b->unwrap;
5305
5306				ok -s $x eq "A c B";
5307
5308
5309				=head1 Contents
5310
5311				The children of each node.
5312
5313				=head2 contents($)
5314
5315				Return all the nodes contained by this node either as an array or as a reference to such an array.
5316
5317				1 $node Node.
5318
5319				Example:
5320
5321
5322				my $x = Data::Edit::Xml::new(<
5323
5324
5325
5326
5327
5328
5329
5330
5331				END
5332
5333				is_deeply [map{-u $_} $x->contents], [qw(b1 d1 e1 b2 d2 e2)];
5334
5335
5336				=head2 contentAfter($)
5337
5338				Return all the sibling following this node.
5339
5340				1 $node Node.
5341
5342				Example:
5343
5344
5345				my $x = Data::Edit::Xml::new(<
5346
5347
5348
5349
5350
5351				END
5352
5353				ok 'f g' eq join ' ', map {$_->tag} $x->go(qw(b e))->contentAfter;
5354
5355
5356				=head2 contentBefore($)
5357
5358				Return all the sibling preceding this node.
5359
5360				1 $node Node.
5361
5362				Example:
5363
5364
5365				my $x = Data::Edit::Xml::new(<
5366
5367
5368
5369
5370
5371				END
5372
5373				ok 'c d' eq join ' ', map {$_->tag} $x->go(qw(b e))->contentBefore;
5374
5375
5376				=head2 contentAsTags($)
5377
5378				Return a string containing the tags of all the nodes contained by this node separated by single spaces.
5379
5380				1 $node Node.
5381
5382				Example:
5383
5384
5385				my $x = Data::Edit::Xml::new(<
5386
5387
5388
5389
5390
5391				END
5392
5393				ok $x->go(qw(b))->contentAsTags eq 'c d e f g';
5394
5395
5396				=head2 contentAfterAsTags($)
5397
5398				Return a string containing the tags of all the sibling nodes following this node separated by single spaces.
5399
5400				1 $node Node.
5401
5402				Example:
5403
5404
5405				my $x = Data::Edit::Xml::new(<
5406
5407
5408
5409
5410
5411				END
5412
5413				ok 'f g' eq join ' ', map {$_->tag} $x->go(qw(b e))->contentAfter;
5414
5415				ok $x->go(qw(b e))->contentAfterAsTags eq 'f g';
5416
5417
5418				=head2 contentBeforeAsTags($)
5419
5420				# Return a string containing the tags of all the sibling nodes preceding this node separated by single spaces.
5421
5422				1 $node Node.
5423
5424				Example:
5425
5426
5427				my $x = Data::Edit::Xml::new(<
5428
5429
5430
5431
5432
5433				END
5434
5435				ok 'c d' eq join ' ', map {$_->tag} $x->go(qw(b e))->contentBefore;
5436
5437				ok $x->go(qw(b e))->contentBeforeAsTags eq 'c d';
5438
5439
5440				=head2 position($)
5441
5442				Return the index of a node in its parent's content.
5443
5444				1 $node Node.
5445
5446				Example:
5447
5448
5449				my $a = Data::Edit::Xml::new(<
5450
5451
5452
5453
5454
5455
5456
5457
5458
5459
5460
5461
5462
5463
5464
5465
5466
5467
5468
5469
5470
5471
5472
5473
5474
5475
5476
5477
5478				END
5479
5480				ok $a->go(qw(b 1 b))->id == 26;
5481
5482				ok $a->go(qw(b 1 b))->position == 2;
5483
5484
5485				=head2 index($)
5486
5487				Return the index of a node in its parent index.
5488
5489				1 $node Node.
5490
5491				Example:
5492
5493
5494				my $a = Data::Edit::Xml::new(<
5495
5496
5497
5498
5499
5500
5501
5502
5503
5504
5505
5506
5507
5508
5509
5510
5511
5512
5513
5514
5515
5516
5517
5518
5519
5520
5521
5522
5523				END
5524
5525				ok $a->go(qw(b 1))->id == 23;
5526
5527				ok $a->go(qw(b 1))->index == 1;
5528
5529
5530				=head2 present($@)
5531
5532				Return the count of the number of the specified tag types present immediately under a node or a hash {tag} = count for all the tags present under the node if no names are specified.
5533
5534				1 $node Node
5535				2 @names Possible tags immediately under the node.
5536
5537				Example:
5538
5539
5540				is_deeply {$a->first->present}, {c=>2, d=>2, e=>1};
5541
5542
5543				=head2 isText($)
5544
5545				Confirm that this is a text node.
5546
5547				1 $node Node to test.
5548
5549				Example:
5550
5551
5552				ok $a->prettyStringCDATA eq <
5553
5554				END
5555
5556				ok $a->first->isText;
5557
5558
5559				Use B to execute L but B 'isText' instead of returning B
5560
5561				=head2 isBlankText($)
5562
5563				Confirm that this node either contains no children or if it does, that they are all blank text
5564
5565				1 $node Node to test.
5566
5567				Example:
5568
5569
5570				ok $a->prettyStringCDATA eq <
5571
5572				END
5573
5574				ok $a->first->isBlankText;
5575
5576
5577				Use B to execute L but B 'isBlankText' instead of returning B
5578
5579				=head2 bitsNodeTextBlank()
5580
5581				Return a bit string that shows if there are tags, text, blank text under a node. An empty string is returned if there are no child nodes
5582
5583
5584				Example:
5585
5586
5587				ok $x->prettyStringCDATA eq <
5588
5589
5590
5591
5592
5593
5594
5595				E
5596
5597
5598
5599
5600
5601
5602
5603
5604
5605				END
5606
5607				ok '100' eq -B $x;
5608
5609				ok '100' eq -B $x->go(qw(b));
5610
5611				ok '110' eq -B $x->go(qw(c));
5612
5613				ok '111' eq -B $x->go(qw(d));
5614
5615				ok !-B $x->go(qw(e));
5616
5617
5618				=head1 Order
5619
5620				Number and verify the order of nodes.
5621
5622				=head2 findByNumber($$)
5623
5624				Find the node with the specified number as made visible by L in the parse tree containing the specified node and return the found node or B if no such node exists.
5625
5626				1 $node Node in the parse tree to search
5627				2 $number Number of the node required.
5628
5629				Example:
5630
5631
5632				$a->numberTree;
5633
5634				ok $a->prettyStringNumbered eq <
5635
5636
5637
5638
5639
5640
5641
5642
5643
5644
5645				END
5646
5647				ok q(D) eq -t $a->findByNumber(7);
5648
5649
5650				Use B to execute L but B 'findByNumber' instead of returning B
5651
5652				=head2 findByNumbers($@)
5653
5654				Find the nodes with the specified numbers as made visible by L in the parse tree containing the specified node and return the found nodes in a list with B for nodes that do not exist.
5655
5656				1 $node Node in the parse tree to search
5657				2 @numbers Numbers of the nodes required.
5658
5659				Example:
5660
5661
5662				$a->numberTree;
5663
5664				ok $a->prettyStringNumbered eq <
5665
5666
5667
5668
5669
5670
5671
5672
5673
5674
5675				END
5676
5677				is_deeply [map {-t $_} $a->findByNumbers(1..3)], [qw(a b A)];
5678
5679
5680				=head2 numberTree($)
5681
5682				Number the parse tree
5683
5684				1 $node Node
5685
5686				Example:
5687
5688
5689				$x->numberTree;
5690
5691				ok -z $x eq <
5692
5693
5694
5695
5696
5697
5698
5699
5700				END
5701
5702
5703				=head2 above($$)
5704
5705				Return the specified node if it is above the specified target otherwise B
5706
5707				1 $node Node
5708				2 $target Target.
5709
5710				Example:
5711
5712
5713				my $x = Data::Edit::Xml::new(<
5714
5715
5716
5717
5718
5719
5720
5721
5722
5723
5724
5725
5726
5727
5728
5729
5730				END
5731
5732				ok $b->id eq 'b1';
5733
5734				ok $e->id eq "e1";
5735
5736				ok $E->id eq "e2";
5737
5738				ok $b->above($e);
5739
5740				ok !$E->above($e);
5741
5742
5743				Use B to execute L but B 'above' instead of returning B
5744
5745				=head2 below($$)
5746
5747				Return the specified node if it is below the specified target otherwise B
5748
5749				1 $node Node
5750				2 $target Target.
5751
5752				Example:
5753
5754
5755				my $x = Data::Edit::Xml::new(<
5756
5757
5758
5759
5760
5761
5762
5763
5764
5765
5766
5767
5768
5769
5770
5771
5772				END
5773
5774				ok $d->id eq 'd1';
5775
5776				ok $e->id eq "e1";
5777
5778				ok !$d->below($e);
5779
5780
5781				Use B to execute L but B 'below' instead of returning B
5782
5783				=head2 after($$)
5784
5785				Return the specified node if it occurs after the target node in the parse tree or else B if the node is L, L or L the target.
5786
5787				1 $node Node
5788				2 $target Targe.t
5789
5790				Example:
5791
5792
5793				my $x = Data::Edit::Xml::new(<
5794
5795
5796
5797
5798
5799
5800
5801
5802
5803
5804
5805
5806
5807
5808
5809
5810				END
5811
5812				ok $c->id eq 'c1';
5813
5814				ok $e->id eq "e1";
5815
5816				ok $e->after($c);
5817
5818
5819				Use B to execute L but B 'after' instead of returning B
5820
5821				=head2 before($$)
5822
5823				Return the specified node if it occurs before the target node in the parse tree or else B if the node is L, L or L the target.
5824
5825				1 $node Node
5826				2 $target Target.
5827
5828				Example:
5829
5830
5831				my $x = Data::Edit::Xml::new(<
5832
5833
5834
5835
5836
5837
5838
5839
5840
5841
5842
5843
5844
5845
5846
5847
5848				END
5849
5850				ok $e->id eq "e1";
5851
5852				ok $E->id eq "e2";
5853
5854				ok $e->before($E);
5855
5856
5857				Use B to execute L but B 'before' instead of returning B
5858
5859				=head2 disordered($@)
5860
5861				Return the first node that is out of the specified order when performing a pre-ordered traversal of the parse tree.
5862
5863				1 $node Node
5864				2 @nodes Following nodes.
5865
5866				Example:
5867
5868
5869				my $x = Data::Edit::Xml::new(<
5870
5871
5872
5873
5874
5875
5876
5877
5878
5879
5880
5881
5882
5883
5884
5885
5886				END
5887
5888				ok $b->id eq 'b1';
5889
5890				ok $c->id eq 'c1';
5891
5892				ok $d->id eq 'd1';
5893
5894				ok $e->id eq "e1";
5895
5896				ok $e->disordered($c )->id eq "c1";
5897
5898				ok $b->disordered($c, $e, $d)->id eq "d1";
5899
5900				ok !$c->disordered($e);
5901
5902
5903				=head2 commonAncestor($@)
5904
5905				Find the most recent common ancestor of the specified nodes or B if there is no common ancestor.
5906
5907				1 $node Node
5908				2 @nodes @nodes
5909
5910				Example:
5911
5912
5913				ok -z $a eq <
5914
5915
5916
5917
5918
5919
5920
5921
5922
5923
5924
5925
5926
5927
5928
5929
5930
5931
5932
5933
5934
5935
5936
5937				END
5938
5939				my ($b, $e, @n) = $a->findByNumbers(2, 4, 6, 9);
5940
5941				ok $e == $e->commonAncestor;
5942
5943				ok $e == $e->commonAncestor($e);
5944
5945				ok $b == $e->commonAncestor($b);
5946
5947				ok $b == $e->commonAncestor(@n);
5948
5949
5950				Use B to execute L but B 'commonAncestor' instead of returning B
5951
5952				=head2 ordered($@)
5953
5954				Return the first node if the specified nodes are all in order when performing a pre-ordered traversal of the parse tree else return B
5955
5956				1 $node Node
5957				2 @nodes Following nodes.
5958
5959				Example:
5960
5961
5962				my $x = Data::Edit::Xml::new(<
5963
5964
5965
5966
5967
5968
5969
5970
5971
5972
5973
5974
5975
5976
5977
5978
5979				END
5980
5981				ok $e->id eq "e1";
5982
5983				ok $E->id eq "e2";
5984
5985				ok $e->ordered($E);
5986
5987				ok !$E->ordered($e);
5988
5989				ok $e->ordered($e);
5990
5991				ok $e->ordered;
5992
5993
5994				Use B to execute L but B 'ordered' instead of returning B
5995
5996				=head1 Labels
5997
5998				Label nodes so that they can be cross referenced and linked by L
5999
6000				=head2 addLabels($@)
6001
6002				Add the named labels to the specified node and return that node.
6003
6004				1 $node Node in parse tree
6005				2 @labels Names of labels to add.
6006
6007				Example:
6008
6009
6010				ok -r $x eq '';
6011
6012				ok $b->countLabels == 0;
6013
6014				$b->addLabels(1..2);
6015
6016				$b->addLabels(3..4);
6017
6018				ok -r $x eq '';
6019
6020
6021				=head2 countLabels($)
6022
6023				Return the count of the number of labels at a node.
6024
6025				1 $node Node in parse tree.
6026
6027				Example:
6028
6029
6030				ok -r $x eq '';
6031
6032				ok $b->countLabels == 0;
6033
6034				$b->addLabels(1..2);
6035
6036				$b->addLabels(3..4);
6037
6038				ok -r $x eq '';
6039
6040				ok $b->countLabels == 4;
6041
6042
6043				=head2 getLabels($)
6044
6045				Return the names of all the labels set on a node.
6046
6047				1 $node Node in parse tree.
6048
6049				Example:
6050
6051
6052				ok -r $x eq '';
6053
6054				ok $b->countLabels == 0;
6055
6056				$b->addLabels(1..2);
6057
6058				$b->addLabels(3..4);
6059
6060				ok -r $x eq '';
6061
6062				is_deeply [1..4], [$b->getLabels];
6063
6064
6065				=head2 deleteLabels($@)
6066
6067				Delete the specified labels in the specified node or all labels if no labels have are specified and return that node.
6068
6069				1 $node Node in parse tree
6070				2 @labels Names of the labels to be deleted
6071
6072				Example:
6073
6074
6075				ok -r $x eq '';
6076
6077				$b->deleteLabels(1,4) for 1..2;
6078
6079				ok -r $x eq '';
6080
6081
6082				=head2 copyLabels($$)
6083
6084				Copy all the labels from the source node to the target node and return the source node.
6085
6086				1 $source Source node
6087				2 $target Target node.
6088
6089				Example:
6090
6091
6092				ok -r $x eq '';
6093
6094				$b->copyLabels($c) for 1..2;
6095
6096				ok -r $x eq '';
6097
6098
6099				=head2 moveLabels($$)
6100
6101				Move all the labels from the source node to the target node and return the source node.
6102
6103				1 $source Source node
6104				2 $target Target node.
6105
6106				Example:
6107
6108
6109				ok -r $x eq '';
6110
6111				$b->moveLabels($c) for 1..2;
6112
6113				ok -r $x eq '';
6114
6115
6116				=head1 Operators
6117
6118				Operator access to methods use the assign versions to avoid 'useless use of operator in void context' messages. Use the non assign versions to return the results of the underlying method call. Thus '/' returns the wrapping node, whilst '/=' does not. Assign operators always return their left hand side even though the corresponding method usually returns the modification on the right.
6119
6120				=head2 opString($$)
6121
6122				-B: L
6123
6124				-b: L
6125
6126				-c: L
6127
6128				-e: L
6129
6130				-f: L
6131
6132				-l: L
6133
6134				-M: L
6135
6136				-o: L
6137
6138				-p: L
6139
6140				-r: L
6141
6142				-s: L
6143
6144				-S : L
6145
6146				-t : L
6147
6148				-u: L
6149
6150				-z: L.
6151
6152				1 $node Node
6153				2 $op Monadic operator.
6154
6155				Example:
6156
6157
6158				my $x = Data::Edit::Xml::new(<
6159
6160
6161
6162
6163
6164
6165
6166
6167				END
6168
6169				my $prev = -b $x->go(q(d));
6170
6171				ok -t $prev eq q(b);
6172
6173				my $next = -c $x->go(q(b));
6174
6175				ok -t $next eq q(d);
6176
6177				my $first = -f $x;
6178
6179				ok -t $first eq q(b);
6180
6181				my $last = -l $x;
6182
6183				ok -t $last eq q(d);
6184
6185				ok -o $x eq "''";
6186
6187				ok -p $x eq <
6188
6189
6190
6191
6192
6193
6194
6195
6196				END
6197
6198				ok -s $x eq '';
6199
6200				ok -t $x eq 'a';
6201
6202				$x->numberTree;
6203
6204				ok -z $x eq <
6205
6206
6207
6208
6209
6210
6211
6212
6213				END
6214
6215
6216				=head2 opContents($)
6217
6218				@{} : content of a node.
6219
6220				1 $node Node.
6221
6222				Example:
6223
6224
6225				ok -p $x eq <
6226
6227
6228
6229
6230
6231
6232
6233
6234				END
6235
6236				ok 'bd' eq join '', map {$_->tag} @$x ;
6237
6238
6239				=head2 opAt($$)
6240
6241				<= : Check that a node is in the context specified by the referenced array of words.
6242
6243				1 $node Node
6244				2 $context Reference to array of words specifying the parents of the desired node.
6245
6246				Example:
6247
6248
6249				ok -p $x eq <
6250
6251
6252
6253
6254
6255
6256
6257
6258				END
6259
6260				ok (($x >= [qw(d e)]) <= [qw(e d a)]);
6261
6262
6263				=head2 opNew($$)
6264
6265				** : create a new node from the text on the right hand side: if the text contains a non word character \W the node will be create as text, else it will be created as a tag
6266
6267				1 $node Node
6268				2 $text Name node of node to create or text of new text element
6269
6270				Example:
6271
6272
6273				my $a = Data::Edit::Xml::new("");
6274
6275				my $b = $a ** q(b);
6276
6277				ok -s $b eq "";
6278
6279
6280				=head2 opPutFirst($$)
6281
6282				>> : put a node or string first under a node and return the new node.
6283
6284				1 $node Node
6285				2 $text Node or text to place first under the node.
6286
6287				Example:
6288
6289
6290				ok -p $a eq <
6291
6292				END
6293
6294				my $f = $a >> qq(first);
6295
6296				ok -p $a eq <
6297
6298
6299
6300				END
6301
6302
6303				=head2 opPutFirstAssign($$)
6304
6305				>>= : put a node or string first under a node.
6306
6307				1 $node Node
6308				2 $text Node or text to place first under the node.
6309
6310				Example:
6311
6312
6313				ok -p $a eq <
6314
6315				END
6316
6317				$a >>= qq(first);
6318
6319				ok -p $a eq <
6320
6321
6322
6323				END
6324
6325
6326				=head2 opPutLast($$)
6327
6328				<< : put a node or string last under a node and return the new node.
6329
6330				1 $node Node
6331				2 $text Node or text to place last under the node.
6332
6333				Example:
6334
6335
6336				ok -p $a eq <
6337
6338
6339
6340				END
6341
6342				my $l = $a << qq(last);
6343
6344				ok -p $a eq <
6345
6346
6347
6348
6349				END
6350
6351
6352				=head2 opPutLastAssign($$)
6353
6354				<<= : put a node or string last under a node.
6355
6356				1 $node Node
6357				2 $text Node or text to place last under the node.
6358
6359				Example:
6360
6361
6362				ok -p $a eq <
6363
6364
6365
6366				END
6367
6368				$a <<= qq(last);
6369
6370				ok -p $a eq <
6371
6372
6373
6374
6375				END
6376
6377
6378				=head2 opPutNext($$)
6379
6380				> + : put a node or string after the specified node and return the new node.
6381
6382				1 $node Node
6383				2 $text Node or text to place after the first node.
6384
6385				Example:
6386
6387
6388				ok -p $a eq <
6389
6390
6391
6392
6393				END
6394
6395				$f += qq(next);
6396
6397				ok -p $a eq <
6398
6399
6400
6401
6402
6403				END
6404
6405
6406				=head2 opPutNextAssign($$)
6407
6408				+= : put a node or string after the specified node.
6409
6410				1 $node Node
6411				2 $text Node or text to place after the first node.
6412
6413				Example:
6414
6415
6416				ok -p $a eq <
6417
6418
6419
6420
6421				END
6422
6423				my $f = -f $a;
6424
6425				$f += qq(next);
6426
6427				ok -p $a eq <
6428
6429
6430
6431
6432
6433				END
6434
6435
6436				=head2 opPutPrev($$)
6437
6438				< - : put a node or string before the specified node and return the new node.
6439
6440				1 $node Node
6441				2 $text Node or text to place before the first node.
6442
6443				Example:
6444
6445
6446				ok -p $a eq <
6447
6448
6449
6450
6451
6452				END
6453
6454				$l -= qq(prev);
6455
6456				ok -p $a eq <
6457
6458
6459
6460
6461
6462
6463				END
6464
6465
6466				=head2 opPutPrevAssign($$)
6467
6468				-= : put a node or string before the specified node,
6469
6470				1 $node Node
6471				2 $text Node or text to place before the first node.
6472
6473				Example:
6474
6475
6476				ok -p $a eq <
6477
6478
6479
6480
6481
6482				END
6483
6484				my $l = -l $a;
6485
6486				$l -= qq(prev);
6487
6488				ok -p $a eq <
6489
6490
6491
6492
6493
6494
6495				END
6496
6497
6498				=head2 opBy($$)
6499
6500				x= : Traverse a parse tree in post-order.
6501
6502				1 $node Parse tree
6503				2 $code Code to execute against each node.
6504
6505				Example:
6506
6507
6508				ok -p $x eq <
6509
6510
6511
6512
6513
6514
6515
6516
6517				END
6518
6519				my $s; $x x= sub{$s .= -t $_}; ok $s eq "cbeda"
6520
6521
6522				=head2 opGo($$)
6523
6524				>= : Search for a node via a specification provided as a reference to an array of words each number. Each word represents a tag name, each number the index of the previous tag or zero by default.
6525
6526				1 $node Node
6527				2 $go Reference to an array of search parameters.
6528
6529				Example:
6530
6531
6532				ok -p $x eq <
6533
6534
6535
6536
6537
6538
6539
6540
6541				END
6542
6543				ok (($x >= [qw(d e)]) <= [qw(e d a)]);
6544
6545
6546				=head2 opAttr($$)
6547
6548				% : Get the value of an attribute of this node.
6549
6550				1 $node Node
6551				2 $attr Reference to an array of words and numbers specifying the node to search for.
6552
6553				Example:
6554
6555
6556				my $a = Data::Edit::Xml::new('');
6557
6558				ok $a % qq(number) == 1;
6559
6560
6561				=head1 Statistics
6562
6563				Statistics describing the parse tree.
6564
6565				=head2 count($@)
6566
6567				Return the count of the number of instances of the specified tags under the specified node, either by tag in array context or in total in scalar context.
6568
6569				1 $node Node
6570				2 @names Possible tags immediately under the node.
6571
6572				Example:
6573
6574
6575				my $x = Data::Edit::Xml::new(<
6576
6577
6578
6579				END
6580
6581				ok $x->count == 0;
6582
6583
6584				=head2 countTags($)
6585
6586				Count the number of tags in a parse tree.
6587
6588				1 $node Parse tree.
6589
6590				Example:
6591
6592
6593				ok -p $a eq <
6594
6595
6596
6597
6598
6599				END
6600
6601				ok $a->countTags == 3;
6602
6603
6604				=head2 countTagNames($$)
6605
6606				Return a hash showing the number of instances of each tag on and below the specified node.
6607
6608				1 $node Node
6609				2 $count Count of tags so far.
6610
6611				Example:
6612
6613
6614				my $x = Data::Edit::Xml::new(<
6615
6616
6617
6618
6619
6620
6621
6622
6623
6624
6625				END
6626
6627				is_deeply $x->countTagNames, { a => 1, b => 2, c => 3 };
6628
6629
6630				=head2 countAttrNames($$)
6631
6632				Return a hash showing the number of instances of each attribute on and below the specified node.
6633
6634				1 $node Node
6635				2 $count Count of attributes so far.
6636
6637				Example:
6638
6639
6640				my $x = Data::Edit::Xml::new(<
6641
6642
6643
6644
6645
6646
6647
6648
6649
6650
6651				END
6652
6653				is_deeply $x->countAttrNames, { A => 1, B => 2, C => 4 };
6654
6655
6656				=head1 Debug
6657
6658				Debugging methods
6659
6660
6661				=head1 Private Methods
6662
6663				=head2 tree($$)
6664
6665				Build a tree representation of the parsed xml which can be easily traversed to look for things.
6666
6667				1 $parent The parent node
6668				2 $parse The remaining parse
6669
6670				=head2 disconnectLeafNode($)
6671
6672				Remove a leaf node from the parse tree and make it into its own parse tree.
6673
6674				1 $node Leaf node to disconnect.
6675
6676				=head2 indexNode($)
6677
6678				Index the children of a node so that we can access them by tag and number.
6679
6680				1 $node Node to index.
6681
6682				=head2 prettyStringEnd($)
6683
6684				Return a readable string representing a node of a parse tree and all the nodes below it as a here document
6685
6686				1 $node Start node
6687
6688				=head2 numberNode($)
6689
6690				Ensure that this node has a number.
6691
6692				1 $node Node
6693
6694				=head2 printAttributes($)
6695
6696				Print the attributes of a node.
6697
6698				1 $node Node whose attributes are to be printed.
6699
6700				Example:
6701
6702
6703				my $x = Data::Edit::Xml::new(my $s = <
6704
6705				END
6706
6707				ok $x->printAttributes eq qq( no="1" word="first");
6708
6709
6710				=head2 printAttributesReplacingIdsWithLabels($)
6711
6712				Print the attributes of a node replacing the id with the labels.
6713
6714				1 $node Node whose attributes are to be printed.
6715
6716				=head2 checkParentage($)
6717
6718				Check the parent pointers are correct in a parse tree.
6719
6720				1 $x Parse tree.
6721
6722				=head2 checkParser($)
6723
6724				Check that every node has a parser.
6725
6726				1 $x Parse tree.
6727
6728				=head2 nn($)
6729
6730				Replace new lines in a string with N to make testing easier.
6731
6732				1 $s String.
6733
6734
6735				=head1 Index
6736
6737
6738				1 L
6739
6740				2 L
6741
6742				3 L
6743
6744				4 L
6745
6746				5 L
6747
6748				6 L
6749
6750				7 L
6751
6752				8 L
6753
6754				9 L
6755
6756				10 L
6757
6758				11 L
6759
6760				12 L
6761
6762				13 L
6763
6764				14 L
6765
6766				15 L
6767
6768				16 L
6769
6770				17 L
6771
6772				18 L
6773
6774				19 L
6775
6776				20 L
6777
6778				21 L
6779
6780				22 L
6781
6782				23 L
6783
6784				24 L
6785
6786				25 L
6787
6788				26 L
6789
6790				27 L
6791
6792				28 L
6793
6794				29 L
6795
6796				30 L
6797
6798				31 L
6799
6800				32 L
6801
6802				33 L
6803
6804				34 L
6805
6806				35 L
6807
6808				36 L
6809
6810				37 L
6811
6812				38 L
6813
6814				39 L
6815
6816				40 L
6817
6818				41 L
6819
6820				42 L
6821
6822				43 L
6823
6824				44 L
6825
6826				45 L
6827
6828				46 L
6829
6830				47 L
6831
6832				48 L
6833
6834				49 L
6835
6836				50 L
6837
6838				51 L
6839
6840				52 L
6841
6842				53 L
6843
6844				54 L
6845
6846				55 L
6847
6848				56 L
6849
6850				57 L
6851
6852				58 L
6853
6854				59 L
6855
6856				60 L
6857
6858				61 L
6859
6860				62 L
6861
6862				63 L
6863
6864				64 L
6865
6866				65 L
6867
6868				66 L
6869
6870				67 L
6871
6872				68 L
6873
6874				69 L
6875
6876				70 L
6877
6878				71 L
6879
6880				72 L
6881
6882				73 L
6883
6884				74 L
6885
6886				75 L
6887
6888				76 L
6889
6890				77 L
6891
6892				78 L
6893
6894				79 L
6895
6896				80 L
6897
6898				81 L
6899
6900				82 L
6901
6902				83 L
6903
6904				84 L
6905
6906				85 L
6907
6908				86 L
6909
6910				87 L
6911
6912				88 L
6913
6914				89 L
6915
6916				90 L
6917
6918				91 L
6919
6920				92 L
6921
6922				93 L
6923
6924				94 L
6925
6926				95 L
6927
6928				96 L
6929
6930				97 L
6931
6932				98 L
6933
6934				99 L
6935
6936				100 L
6937
6938				101 L
6939
6940				102 L
6941
6942				103 L
6943
6944				104 L
6945
6946				105 L
6947
6948				106 L
6949
6950				107 L
6951
6952				108 L
6953
6954				109 L
6955
6956				110 L
6957
6958				111 L
6959
6960				112 L
6961
6962				113 L
6963
6964				114 L
6965
6966				115 L
6967
6968				116 L
6969
6970				117 L
6971
6972				118 L
6973
6974				119 L
6975
6976				120 L
6977
6978				121 L
6979
6980				122 L
6981
6982				123 L
6983
6984				124 L
6985
6986				125 L
6987
6988				126 L
6989
6990				127 L
6991
6992				128 L
6993
6994				129 L
6995
6996				130 L
6997
6998				131 L
6999
7000				132 L
7001
7002				133 L
7003
7004				134 L
7005
7006				135 L
7007
7008				136 L
7009
7010				137 L
7011
7012				138 L
7013
7014				139 L
7015
7016				140 L
7017
7018				141 L
7019
7020				142 L
7021
7022				143 L
7023
7024				144 L
7025
7026				145 L
7027
7028				146 L
7029
7030				147 L
7031
7032				148 L
7033
7034				149 L
7035
7036				150 L
7037
7038				151 L
7039
7040				152 L
7041
7042				153 L
7043
7044				154 L
7045
7046				155 L
7047
7048				156 L
7049
7050				157 L
7051
7052				158 L
7053
7054				159 L
7055
7056				160 L
7057
7058				161 L
7059
7060				162 L
7061
7062				163 L
7063
7064				164 L
7065
7066				165 L
7067
7068				166 L
7069
7070				167 L
7071
7072				168 L
7073
7074				169 L
7075
7076				170 L
7077
7078				171 L
7079
7080				172 L
7081
7082				173 L
7083
7084				174 L
7085
7086				175 L
7087
7088				176 L
7089
7090				177 L
7091
7092				178 L
7093
7094				179 L
7095
7096				180 L
7097
7098				181 L
7099
7100				182 L
7101
7102				183 L
7103
7104				184 L
7105
7106				185 L
7107
7108				186 L
7109
7110				187 L
7111
7112				188 L
7113
7114				189 L
7115
7116				190 L
7117
7118				191 L
7119
7120				192 L
7121
7122				193 L
7123
7124				194 L
7125
7126				195 L
7127
7128				196 L
7129
7130				197 L
7131
7132				198 L
7133
7134				199 L
7135
7136				200 L
7137
7138				201 L
7139
7140				202 L
7141
7142				203 L
7143
7144				204 L
7145
7146				205 L
7147
7148				206 L
7149
7150				207 L
7151
7152				208 L
7153
7154				209 L
7155
7156				210 L
7157
7158				211 L
7159
7160				212 L
7161
7162				213 L
7163
7164				214 L
7165
7166				215 L
7167
7168				216 L
7169
7170				217 L
7171
7172				218 L
7173
7174				219 L
7175
7176				220 L
7177
7178				221 L
7179
7180				222 L
7181
7182				223 L
7183
7184				224 L
7185
7186				225 L
7187
7188				226 L
7189
7190				227 L
7191
7192				228 L
7193
7194				229 L
7195
7196				=head1 Installation
7197
7198				This module is written in 100% Pure Perl and, thus, it is easy to read, use,
7199				modify and install.
7200
7201				Standard L process for building and installing modules:
7202
7203				perl Build.PL
7204				./Build
7205				./Build test
7206				./Build install
7207
7208				=head1 Author
7209
7210				L
7211
7212				L
7213
7214				=head1 Copyright
7215
7216				Copyright (c) 2016-2017 Philip R Brenan.
7217
7218				This module is free software. It may be used, redistributed and/or modified
7219				under the same terms as Perl itself.
7220
7221				=cut
7222
7223
7224				sub aboveX {&above (@_) \|\| die 'above'}
7225				sub afterX {&after (@_) \|\| die 'after'}
7226				sub atX {&at (@_) \|\| die 'at'}
7227				sub beforeX {&before (@_) \|\| die 'before'}
7228				sub belowX {&below (@_) \|\| die 'below'}
7229				sub changeX {&change (@_) \|\| die 'change'}
7230				sub commonAncestorX {&commonAncestor (@_) \|\| die 'commonAncestor'}
7231				sub equalsX {&equals (@_) \|\| die 'equals'}
7232				sub findByNumberX {&findByNumber (@_) \|\| die 'findByNumber'}
7233				sub firstX {&first (@_) \|\| die 'first'}
7234				sub firstContextOfX {&firstContextOf (@_) \|\| die 'firstContextOf'}
7235				sub firstInX {&firstIn (@_) \|\| die 'firstIn'}
7236				sub firstInIndexX {&firstInIndex (@_) \|\| die 'firstInIndex'}
7237				sub goX {&go (@_) \|\| die 'go'}
7238				sub isBlankTextX {&isBlankText (@_) \|\| die 'isBlankText'}
7239				sub isEmptyX {&isEmpty (@_) \|\| die 'isEmpty'}
7240				sub isFirstX {&isFirst (@_) \|\| die 'isFirst'}
7241				sub isLastX {&isLast (@_) \|\| die 'isLast'}
7242				sub isOnlyChildX {&isOnlyChild (@_) \|\| die 'isOnlyChild'}
7243				sub isTextX {&isText (@_) \|\| die 'isText'}
7244				sub lastX {&last (@_) \|\| die 'last'}
7245				sub lastContextOfX {&lastContextOf (@_) \|\| die 'lastContextOf'}
7246				sub lastInX {&lastIn (@_) \|\| die 'lastIn'}
7247				sub lastInIndexX {&lastInIndex (@_) \|\| die 'lastInIndex'}
7248				sub matchAfterX {&matchAfter (@_) \|\| die 'matchAfter'}
7249				sub matchBeforeX {&matchBefore (@_) \|\| die 'matchBefore'}
7250				sub nextX {&next (@_) \|\| die 'next'}
7251				sub nextInX {&nextIn (@_) \|\| die 'nextIn'}
7252				sub orderedX {&ordered (@_) \|\| die 'ordered'}
7253				sub overX {&over (@_) \|\| die 'over'}
7254				sub prevX {&prev (@_) \|\| die 'prev'}
7255				sub prevInX {&prevIn (@_) \|\| die 'prevIn'}
7256				sub restoreX {&restore (@_) \|\| die 'restore'}
7257				sub uptoX {&upto (@_) \|\| die 'upto'}
7258				sub wrapToX {&wrapTo (@_) \|\| die 'wrapTo'}
7259
7260				sub firstNonBlank
7261				{my $r = &first($_[0]);
7262				return undef unless $r;
7263				if ($r->isBlankText)
7264				{shift @_;
7265				return &next($r, @_)
7266				}
7267				else
7268				{return &next(@_);
7269				}
7270				}
7271
7272				sub firstNonBlankX
7273				{my $r = &firstNonBlank(@_);
7274				die 'first' unless defined($r);
7275				$r
7276				}
7277
7278				sub lastNonBlank
7279				{my $r = &last($_[0]);
7280				return undef unless $r;
7281				if ($r->isBlankText)
7282				{shift @_;
7283				return &prev($r, @_)
7284				}
7285				else
7286				{return &prev(@_);
7287				}
7288				}
7289
7290				sub lastNonBlankX
7291				{my $r = &lastNonBlank(@_);
7292				die 'last' unless defined($r);
7293				$r
7294				}
7295
7296				sub nextNonBlank
7297				{my $r = &next($_[0]);
7298				return undef unless $r;
7299				if ($r->isBlankText)
7300				{shift @_;
7301				return &next($r, @_)
7302				}
7303				else
7304				{return &next(@_);
7305				}
7306				}
7307
7308				sub nextNonBlankX
7309				{my $r = &nextNonBlank(@_);
7310				die 'next' unless defined($r);
7311				$r
7312				}
7313
7314				sub prevNonBlank
7315				{my $r = &prev($_[0]);
7316				return undef unless $r;
7317				if ($r->isBlankText)
7318				{shift @_;
7319				return &prev($r, @_)
7320				}
7321				else
7322				{return &prev(@_);
7323				}
7324				}
7325
7326				sub prevNonBlankX
7327				{my $r = &prevNonBlank(@_);
7328				die 'prev' unless defined($r);
7329				$r
7330				}
7331
7332
7333				# Tests and documentation
7334
7335				sub test
7336				{my $p = __PACKAGE__;
7337				binmode($_, ":utf8") for STDOUT, STDERR;
7338				return if eval "eof(${p}::DATA)";
7339				my $s = eval "join('', <${p}::DATA>)";
7340				$@ and die $@;
7341				eval $s;
7342				$@ and die $@;
7343				}
7344
7345				test unless caller;
7346
7347				1;
7348				# podDocumentation
7349				__DATA__