File Coverage

blib/lib/Data/Edit/Xml.pm

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

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