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