Data-Edit-Xml
view release on metacpan or search on metacpan
lib/Data/Edit/Xml.pm view on Meta::CPAN
# When deleting content should putFirstCut check that the cut node is not above the target node ?.
# add*asTree
# change wrap and other commands that use %attributes rather than @context to use @context
# swap c and cc
# root finds the root node possibly obviating the need for the parser attribute?
# Stop unwrap from confessing to being on the root node
# Parse DTDs so that we can separate a classification map from a conventional map
# #b means the method acts on one node and returns a string - its braceable
package Data::Edit::Xml;
our $VERSION = 20201031;
use v5.26;
use warnings FATAL => qw(all);
use strict;
use Carp qw(confess cluck);
use Data::Dump qw(dump);
use Data::Table::Text qw(:all);
#se Dita::Validate;
use XML::Parser; # https://metacpan.org/pod/XML::Parser
use Storable qw(dclone freeze retrieve store thaw);
use utf8;
#D1 Construction # Create a parse tree, either by parsing a L<file or string|/file or string> B<or> L<node by node|/Node by Node> B<or> from another L<parse tree|/Parse tree>.
#D2 File or String # Construct a parse tree from a file or a string.
our $lastParseError; # The last parse error encountered
sub new(;$@) #IS Create a new parse tree - call this method statically as in Data::Edit::Xml::new(file or string) to parse a file or string B<or> with no parameters and then use L</in...
{my ($fileNameOrString, @options) = @_; # Optional file name or string from which to construct the parse tree, hash of other options.
shift @_ while @_ && ref($_[0]); # Remove any leading references to find the actual string or file to be parsed
my ($source, %options) = @_; # Assign parameters - the one higher up is for documentation only
checkKeys(\%options, # Check report options
{lineNumbers => <<'END',
Save the line number.column number at which tag starts and ends on
the xtrf attribute of each node if true.
END
input => <<'END',
Specifies the string or file name containing the source xml to be parsed if true
END
inputString => <<'END',
Specifies the string of xml to be parsed if true
END
inputFile => <<'END',
Specifies the name of the input file containing the source xml to be parsed if true.
END
errorsFile => <<'END',
Specifies the file to which any parse errors will be written to. By default this file is named: B<zzzParseErrors/out.data>.
END
});
if (@_)
{my $x = bless {input=>@_}; # Create L<XML> editor with a string or file
$x->parser = $x; # Parser root node
return $x->parse; # Parse
}
my $x = bless {}; # Create empty L<XML> editor
$x->parser = $x; # Parser root node
$x # Parser
}
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<confess>.
{'CDATA'
}
sub reduceParseErroMessage($) #P Reduce the parse failure message to the bare essentials.
{my ($e) = @_; # Error message
if ($e =~ m((not well-formed.*?byte\s*\d+))is) {return $1}
$e # Return full message of it cannot be further reduced
}
sub parse($) # Parse input L<XML> specified via: L<inputFile|/inputFile>, L<input|/input> or L<inputString|/inputString>.
{my ($parser) = @_; # Parser created by L</new>
if (my $s = $parser->input) # Source to be parsed is a file or a string
{if ($s =~ /\n/s or !-e $s) # Parse as a string because it does not look like a file name
{$parser->inputString = $s;
}
else # Parse a file
{$parser->inputFile = $s;
$parser->inputString = readFile($s);
}
}
elsif (my $f = $parser->inputFile) # Source to be parsed is a file
{$parser->inputString = readFile($f);
}
elsif ($parser->inputString) {} # Source to be parsed is a string
else # Unknown string
{confess "Supply a string or file to be parsed";
}
my $xmlParser = new XML::Parser(Style => 'Tree'); # Extend Larry Wall's excellent L<XML> parser
my $D = $parser->inputString; # String to be parsed
my $d = $parser->lineNumbers ? &addLineNumbers($D) : $D; # Add line numbers if requested
$d =~ s(&(?!(amp|gt|lt|quot|#x?\d+);)) (&)gs; # Correct free floating ampersands
my $x = eval {$xmlParser->parse($d)}; # Parse string
$lastParseError = reduceParseErroMessage($@); # Record any error
if (!$x) # Error in parse: write a message to STDERR and to a file if possible
{my $f = $parser->inputFile ? "Source file is:\n". # Source details if a file
$parser->inputFile."\n" : '';
my $s = $lastParseError;
eval {confess "Parse failed at:\n"}; # Stack of parse failure
my $e = "$d\n$f\n$@\n$s\n"; # Error
# warn "Xml parse error: $e"; # Write a description of the error to STDERR before attempting to write to a file
my $badFile = $parser->errorsFile || # File name to write error analysis to
fullFileName(filePathExt(qw(zzzParseErrors out data)));
unlink $badFile if -e $badFile; # Remove existing errors file
writeFile($badFile, $e); # Write a description of the error to the errorsFile
confess "Xml parse error, see file:\n$badFile\n$s\n"; # Complain helpfully if parse failed
}
$parser->tree($x); # Structure parse results as a tree
if (my @c = @{$parser->content}) # Set additional attributes on root node
{confess "No XML" if !@c;
confess "More than one outer-most tag" if @c > 1;
my $c = $c[0];
$parser->tag = $c->tag;
$parser->attributes = $c->attributes;
$parser->content = $c->content;
$parser->parent = undef;
$parser->indexNode;
}
$parser # Parse details
}
sub tree($$) #P Build a tree representation of the parsed L<XML> which can be easily traversed to look for things.
{my ($parent, $parse) = @_; # The parent node, the remaining parse
while(@$parse)
{my $tag = shift @$parse; # Tag for node
my $node = bless {parser=>$parent->parser}; # New node
if ($tag eq cdata)
{confess cdata.' tag encountered'; # We use this tag for text and so it cannot be used as a user tag in the document
}
elsif ($tag eq '0') # Text
{my $s = shift @$parse;
if ($s !~ /\A\s*\Z/) # Ignore entirely blank strings
{$s = replaceSpecialChars($s); # Restore special characters in the text
$node->tag = cdata; # Save text. ASSUMPTION: CDATA is not used as a tag anywhere.
$node->text = $s;
push @{$parent->content}, $node; # Save on parents content list
}
}
else # Node
{my $children = shift @$parse;
my $attributes = shift @$children;
$node->tag = $tag; # Save tag
$_ = replaceSpecialChars($_) for values %$attributes; # Restore in text with L<XML> special characters
$node->attributes = $attributes; # Save attributes
push @{$parent->content}, $node; # Save on parents content list
$node->tree($children) if $children; # Add nodes below this node
}
}
$parent->indexNode; # Index this node
}
sub addLineNumbers($) #P Add line numbers to the source
{my ($string) = @_; # Source string
my @s = split //, ($string =~ s(<!--linted:.*\Z) ()gsr); # Remove any trailing lint comments
my $state = 0; # 0 - outside any tag, 1 - inside a tag
my $Line = 1; # Current tag start position
my $Col = 0;
my $line = 1; # Current position
my $col = 0;
for my $i(keys @s) # Each input character
{my $c = $s[$i]; # current character
++$col;
if ($c eq qq(\n)) # Line/column number
{++$line;
$col = 0;
}
elsif ($state == 0) # Looking for the start of a tag
{if ($c eq q(<) and ($s[$i+1]//'') =~ m(\A[^/?!]\Z)s) # Exclude non tags
{($Line, $Col) = ($line, $col); # Record start position
$state = 1; # Looking for end
}
}
elsif ($c eq q(>)) # At end of tag
{if ($state == 1) # Inside a tag
{my $m = join '', ' xtrf="', $Line, '.', $Col, ':', # Line number uses an increment
($line == $Line ? q() : ($line-$Line).q(.)), $col, '"';
if (($s[$i-1]//'') ne q(/)) # Tag with content
{$s[$i] = $m.'>';
}
else # Tag with no content
{$s[$i-1] = $m.'/';
}
$state = 0; # Looking for the next tag
}
}
}
join '', @s # New source string
}
#D2 Node by Node # Construct a parse tree node by node.
sub newText($$) # Create a new text node.
{my (undef, $text) = @_; # Any reference to this package, content of new text node
my $node = bless {}; # New node
$node->parser = $node; # Root node of this parse
$node->tag = cdata; # Text node
$node->text = $text; # Content of node
$node # Return new non text node
}
sub newTag($$%) # Create a new non text node.
{my (undef, $command, %attributes) = @_; # Any reference to this package, the tag for the node, attributes as a hash.
my $node = bless {}; # New node
$node->parser = $node; # Root node of this parse
$node->tag = $command; # Tag for node
$node->attributes = \%attributes; # Attributes for node
$node # Return new node
}
sub newTree($%) # Create a new tree.
{my ($command, %attributes) = @_; # The name of the root node in the tree, attributes of the root node in the tree as a hash.
&newTag(undef, @_)
}
sub dupTag($@) #C Create a new non text node by duplicating the tag of an existing node.
{my ($node, @context) = @_; # Node, optional context
return undef if @context and !$node->at(@context); # Not in specified context
my $new = bless {}; # New node
$new->parser = $node->parser; # Root node of this parse
$new->tag = $node->tag; # Tag for node
$new # Return new node
}
sub disconnectLeafNode($) #P Remove a leaf node from the parse tree and make it into its own parse tree.
{my ($node) = @_; # Leaf node to disconnect.
$node->parent = undef; # No parent
$node->parser = $node; # Own parse tree
}
sub reindexNode($) #P Index the children of a node so that we can access them by tag and number.
{my ($node) = @_; # Node to index.
delete $node->{indexes}; # Delete the indexes
for my $n($node->contents) # Index content
{push @{$node->indexes->{$n->tag}}, $n; # Indices to sub nodes
}
}
sub indexNode($) #P Merge multiple text segments and set parent and parser after changes to a node
{my ($node) = @_; # Node to index.
return unless keys @{$node->{content}};
my @contents = @{$node->content}; # Contents of the node
# eval {grep {$_->{tag} eq cdata} @contents};
# $@ and confess "$@\n";
if ((grep {$_->{tag} eq cdata} @contents) > 1) # Make parsing easier for the user by concatenating successive text nodes - NB: this statement has been optimized
{my (@c, @t); # New content, pending intermediate texts list
for(@contents) # Each node under the current node
{if ($_->{tag} eq cdata) # Text node. NB: optimized
{push @t, $_; # Add the text node to pending intermediate texts list
}
elsif (@t == 1) # Non text element encountered with one pending intermediate text
{push @c, @t, $_; # Save the text node and the latest non text node
@t = (); # Empty pending intermediate texts list
}
elsif (@t > 1) # Non text element encountered with two or more pending intermediate texts
{my $t = shift @t; # Reuse the first text node
$t->text .= join '', map {$_->text} @t; # Concatenate the remaining text nodes
$_->disconnectLeafNode for @t; # Disconnect the remain text nodes as they are no longer needed
push @c, $t, $_; # Save the resulting text node and the latest non text node
@t = (); # Empty pending intermediate texts list
}
else {push @c, $_} # Non text node encountered without immediately preceding text
}
if (@t == 0) {} # No action required if no pending text at the end
elsif (@t == 1) {push @c, @t} # Just one text node
else # More than one text node - remove leading and trailing blank text nodes
{my $t = shift @t; # Reuse the first text node
$t->text .= join '', map {$_->text} @t; # Concatenate the remaining text nodes
$_->disconnectLeafNode for @t; # Disconnect the remain text nodes as they are no longer needed
push @c, $t; # Save resulting text element
}
@contents = @c; # The latest content of the node
$node->content = \@c; # Node contents with concatenated text elements
}
my $parser = $node->parser; # Parser for this node
for(@contents) # Index content
{$_->{parent} = $node; # Point to parent
$_->{parser} = $parser; # Point to parser
}
}
sub replaceSpecialChars($) #S Replace < > " & with < > " & Larry Wall's excellent L<Xml parser> unfortunately replaces < > " & etc. with their expansions in text by de...
{my ($string) = @_; # String to be edited.
$string =~ s/\&/&/g; # At this point all & that prefix variables should have been expanded, so any that are left are are real &s which should be replaced with &
$string =~ s/\</</gr =~ s/\>/>/gr =~ s/\"/"/gr # Replace the special characters that we can replace.
}
sub undoSpecialChars($) #S Reverse the results of calling L<replaceSpecialChars|/replaceSpecialChars>.
{my ($string) = @_; # String to be edited.
$string =~ s/&/\&/g; # At this point all & that prefix variables should have been expanded, so any that are left are are real &s which should be replaced with &
$string =~ s/</\</gr =~ s/>/\>/gr =~ s/"/\"/gr # Replace the special characters that we can replace.
}
#D2 Parse tree attributes # Attributes of a node in a parse tree. For instance the attributes associated with an L<XML> tag are held in the L<attributes|/attributes> attribute. It should not be ne...
genHash(__PACKAGE__, # L<XML> parser definition
content=>[], # Content of command: the nodes immediately below the specified B<$node> in the order in which they appeared in the source text, see also L</Contents>.
numbers=>[], # Nodes by number.
data=>{}, # A hash added to the node for use by the programmer during transformations. The data in this hash will not be printed by any of the L<printed|/Print> methods and so can ...
attributes=>{}, # The attributes of the specified B<$node>, see also: L</Attributes>. The frequently used attributes: class, id, href, outputclass can be accessed by an L<lvalueMethod> ...
conditions=>{}, # Conditional strings attached to a node, see L</Conditions>.
forestNumbers=>{}, # Index to node by forest number as set by L<numberForest|/numberForest>.
indexes=>{}, # Indexes to sub commands by tag in the order in which they appeared in the source text.
labels=>{}, # The labels attached to a node to provide addressability from other nodes, see: L</Labels>.
depthProfileLast=>undef, # The last known depth profile for this node as set by L<setDepthProfiles|/setDepthProfiles>.
errorsFile=>undef, # Error listing file. Use this parameter to explicitly set the name of the file that will be used to write any L<parse|/parse> errors to. By default this file is named: B...
inputFile=>undef, # Source file of the L<parse|/parse> if this is the L<parser|/parse> root node. Use this parameter to explicitly set the file to be L<parsed|/parse>.
input=>undef, # Source of the L<parse|/parse> if this is the L<parser|/parse> root node. Use this parameter to specify some input either as a string or as a file name for the L<parser|...
inputString=>undef, # Source string of the L<parse|/parse> if this is the L<parser|/parse> root node. Use this parameter to explicitly set the string to be L<parsed|/parse>.
lineNumbers=>undef, # If true then save the line number.column number at which tag starts and ends on the xtrf attribute of each node.
numbering=>undef, # Last number used to number a node in this L<parse|/parse> tree.
number=>undef, # Number of the specified B<$node>, see L<findByNumber|/findByNumber>.
parent=>undef, # Parent node of the specified B<$node> or B<undef> if the L<parser|/parse> root node. See also L</Traversal> and L</Navigation>. Consider as read only.
parser=>undef, # L<Parser|/parse> details: the root node of a tree is the L<parser|/parse> node for that tree. Consider as read only.
representationLast=>undef, # The last representation set for this node by one of: L<setRepresentationAsTagsAndText|/setRepresentationAsTagsAndText>.
tag=>undef, # Tag name for the specified B<$node>, see also L</Traversal> and L</Navigation>. Consider as read only.
text=>undef, # Text of the specified B<$node> but only if it is a text node otherwise B<undef>, i.e. the tag is cdata() <=> L</isText> is true.
);
#D2 Parse tree # Construct a L<parse|/parse> tree from another L<parse|/parse> tree.
sub renew($@) #C Returns a renewed copy of the L<parse|/parse> tree by first printing it and then re-parsing it, optionally checking that the starting node is in a specified context: u...
{my ($node, @context) = @_; # Node to renew from, optional context
return undef if @context and !$node->at(@context); # Not in specified context
my $x = new($node->string); # Reconstruct parse tree from node
$x->inputFile = $node->root->inputFile; # Convey the input file name if present so that relative references can be resolved in the new parse tree
$x # Return new parse tree
}
sub clone($) #C Return a clone of the entire L<parse|/parse> tree which is created using the fast L<Storable::dclone> method. The L<parse|/parse> tree is cloned without converting it ...
{my ($tree) = @_; # Parse tree
my $new = dclone($tree);
# $new->parent = undef;
$new->parser = $new;
$new->cut;
}
sub equals($$) #Y Return the first node if the two L<parse|/parse> trees have identical representations via L<string|/string>, else B<undef>.
{my ($node1, $node2) = @_; # Parse tree 1, parse tree 2.
$node1->string eq $node2->string ? $node1 : undef # Test
}
sub equalsIgnoringAttributes($$@) # Return the first node if the two L<parse|/parse> trees have identical representations via L<string|/string> if the specified attributes are ignored, else B<undef>.
{my ($node1, $node2, @attributes) = @_; # Parse tree 1, parse tree 2, attributes to ignore during comparison
my $p = $node1->clone; # Clone the parse trees so we can modify them
my $q = $node2->clone;
for my $x($p, $q) # Remove specified attributes from clones of parse trees
{$x->by(sub
{$_->deleteAttrs(@attributes);
})
}
$p->string eq $q->string ? $node1 : undef # Compare the reduced parse trees
}
sub normalizeWhiteSpace($) #PS Normalize white space, remove comments DOCTYPE and L<XML> processors from a string
{my ($string) = @_; # String to normalize
$string =~ s(<\?.*?\?>) ( )gs; # Processors
$string =~ s(<!--.*?-->) ( )gs; # Comments
$string =~ s(<!DOCTYPE.+?>) ( )gs; # Doctype
$string =~ s(\s+) ( )gs; # White space
$string
}
sub diff($$;$) # Return () if the dense string representations of the two nodes are equal, else up to the first N (default 16) characters of the common prefix before the point of diverg...
{my ($first, $second, $N) = @_; # First node, second node, maximum length of difference strings to return
$first = new($first) unless ref $first; # Auto vivify the first node if necessary
$second = new($second) unless ref $second; # Auto vivify the second node if necessary
$N //= 16;
my $a = normalizeWhiteSpace(-s $first); # Convert to normalized strings
my $b = normalizeWhiteSpace(-s $second);
return () if length($a) == length($b) and $a eq $b; # Equal strings
my @a = split //, $a; # Split into characters
my @b = split //, $b;
my @c; # Common prefix
while(@a and @b and $a[0] eq $b[0]) # Remove equal prefix characters
{push @c, shift @a; shift @b; # Save common prefix
lib/Data/Edit/Xml.pm view on Meta::CPAN
my $r = $s # Closing tag
.q(<span class="xmlLtSlash"></</span>)
.$t
.q(<span class="xmlGt">></span>)
."\n";
return $r if $depth; # Return from sub tree
my $h = join "\n", map {qq(<div class="xmlLine">$_</div>)} split m/\n/, $r; # Wrap div around each line
qq($h\n)
}
sub prettyStringHtml($@) # Return a string of L<html> representing a node of a L<parse|/parse> tree and all the nodes below it if the node is in the specified context.
{my ($node, @context) = @_; # Node, optional context
return undef if @context and !$node->at(@context); # Check optional context
prettyStringHtml2($node, 0); # Print as html
}
sub prettyStringDitaHeaders($) #U Return a readable string representing the L<parse|/parse> tree below the specified B<$node> with appropriate headers. Or use L<-x|/opString> $node
{my ($node) = @_; # Start node
# cluck "Please use: ditaPrettyPrintWithHeaders...redirecting";
$node->ditaPrettyPrintWithHeaders
}
sub prettyStringNumbered($;$) #U Return a readable string representing a node of a L<parse|/parse> tree and all the nodes below it with a L<number|/number> attached to each tag. The node numbers can t...
{my ($node, $depth) = @_; # Start node, optional depth.
$depth //= 0; # Start depth if none supplied
my $N = $node->number; # Node number if present
if ($node->isText) # Text node
{my $n = $node->next;
my $s = !defined($n) || $n->isText ? '' : "\n"; # Add a new line after contiguous blocks of text to offset next node
return ($N ? "($N)" : '').$node->text.$s; # Number text
}
my $t = $node->tag; # Number tag in a way which allows us to skip between start and end tags in L<Geany|http://www.geany.org> using the ctrl+up and ctrl+down arrows
my $i = $N && !defined($node->id) ? " id=\"$N\"" : ''; # Use id to hold tag
my $content = $node->content; # Sub nodes
my $space = " "x($depth//0);
return $space.'<'.$t.$i.$node->printAttributes.'/>'."\n" if !@$content; # No sub nodes
my $s = $space.'<'.$t.$i.$node->printAttributes.'>'. # Has sub nodes
($node->first->isText ? '' : "\n"); # Continue text on the same line, otherwise place nodes on following lines
$s .= $_->prettyStringNumbered($depth+1) for @$content; # Recurse to get the sub content
$s .= $node->last->isText ? ((grep{!$_->isText} @$content) # Continue text on the same line, otherwise place nodes on following lines
? "\n$space": "") : $space;
my $r = $s . '</'.$t.'>'."\n"; # Closing tag
return $r if $depth; # Return from sub tree
$r =~ s(>\n( *[.,;:\)] *)) (>$1\n)gsr # Overall result moves some punctuation through one new line to be closer to its tag
}
sub prettyStringCDATA($;$) #U Return a readable string representing a node of a L<parse|/parse> tree and all the nodes below it with the text fields wrapped with <CDATA>...</CDATA>.
{my ($node, $depth) = @_; # Start node, optional depth.
$depth //= 0; # Start depth if none supplied
if ($node->isText) # Text node
{my $n = $node->next;
my $s = !defined($n) || $n->isText ? '' : "\n"; # Add a new line after contiguous blocks of text to offset next node
return '<'.cdata.'>'.$node->text.'</'.cdata.'>'.$s;
}
my $t = $node->tag; # Not text so it has a tag
my $content = $node->content; # Sub nodes
my $space = " "x($depth//0);
return $space.'<'.$t.$node->printAttributes.'/>'."\n" if !@$content; # No sub nodes
my $s = $space.'<'.$t.$node->printAttributes.'>'. # Has sub nodes
($node->first->isText ? '' : "\n"); # Continue text on the same line, otherwise place nodes on following lines
$s .= $_->prettyStringCDATA($depth+2) for @$content; # Recurse to get the sub content
$s .= $node->last->isText ? ((grep{!$_->isText} @$content) # Continue text on the same line, otherwise place nodes on following lines
? "\n$space": "") : $space;
my $r = $s . '</'.$t.'>'."\n"; # Closing tag
return $r if $depth; # Return from sub tree
$r =~ s(>\n( *[.,;:\)] *)) (>$1\n)gsr # Overall result moves some punctuation through one new line to be closer to its tag
}
sub prettyStringEnd($) #PU Return a readable string representing a node of a L<parse|/parse> tree and all the nodes below it as a here document
{my ($node) = @_; # Start node
my $s = -p $node; # Pretty string representation
' ok -p $x eq <<END;'. "\n".(-p $node). "\nEND" # Here document
}
sub prettyStringContent($) #U Return a readable string representing all the nodes below a node of a L<parse|/parse> tree.
{my ($node) = @_; # Start node.
my $s = '';
$s .= $_->prettyString for $node->contents; # Recurse to get the sub content
$s
}
sub prettyStringContentNumbered($) #U Return a readable string representing all the nodes below a node of a L<parse|/parse> tree with numbering added.
{my ($node) = @_; # Start node.
my $s = '';
$s .= $_->prettyStringNumbered for $node->contents; # Recurse to get the sub content
$s
}
sub xmlHeader($) #S Add the standard L<XML> header to a string
{my ($string) = @_; # String to which a standard L<XML> header should be prefixed
<<END
<?xml version="1.0" encoding="UTF-8"?>
$string
END
}
#D2 Html/Json # Represent the L<parse|/parse> tree using html or Json
sub htmlTables($) # Return a string of html representing a L<parse|/parse> tree.
{my ($node) = @_; # Start node of parse tree
my $bgColor = sub # Create a random background color
{join q(), q(bgcolor="#), (map {sprintf("%02x", $_)} @_), q(");
};
my $idNumber = 0;
my $id = sub # Create the next id number
{++$idNumber
};
my @actions = qw(dup rename cut paste unwrap wrap wrapContent);
lib/Data/Edit/Xml.pm view on Meta::CPAN
else if (event.code == "KeyU")
{alert("unwrap path "+target.getAttribute("path"));
}
}
</script>
</html>
END
join '', map {qq($_\n)} @h
}
sub jsonString2($) #P Return a Json representation of a parse tree
{my ($node) = @_; # Start node of parse tree
my $n = {tag=>$node->tag, # New node
(keys(%{$node->attributes}) ? (attributes => $node->attributes) : ()),
($node->isText ? (text => $node->text) : ())};
for my $c($node->contents) # Add content, hoisting any initial text node to the text field.
{push @{$n->{contents}}, $c->jsonString2;
}
$n
}
sub jsonString($) #U Return a Json representation of a parse tree
{my ($node) = @_; # Start node of parse tree
encodeJson($node->jsonString2) =~ s(([\}\]],)) ($1\n)gsr; # Encode Perl to Json with some line breaks added.
}
sub xmlToJson($;$) #S Return a Json string representing valid L<XML> contained in a file or string, optionally double escaping escape characters.
{my ($xml, $escape) = @_; # File name or string of valid html, double escape the escaped characters if true
ref($xml) and confess "Expected a string or a file name";
my $j = jsonString(new($xml)); # Json string
$j =~ s(\\) (\\\\)gs if $escape; # Escape if requested
$j
}
sub jsonToXml2($) #P Convert a json string to an L<XML> parse tree
{my ($node) = @_; # Start node of parse tree
my $a = $$node{attributes}; # Attributes
my $n = bless {tag=>$$node{tag},(keys(%$a) ? (attributes => $a) : ())}; # Tag and attributes
$$n{text} = trim($$node{text}) if $$node{text}; # Avoid endless blank line expansion of text
push @{$$n{content}}, &jsonToXml2($_) for @{$$node{contents}}; # Add content
$n
}
sub jsonToXml($) # Convert a json string representing an L<XML> parse tree into an L<XML> parse tree
{my ($json) = @_; # Json string
my $p = decodeJson($json); # Json represented as Perl
my $x = jsonToXml2($p); # Parse tree - enough to print
my $s = string($x); # Parse tree as string
new($s); # Recreate full parse tree from string
}
#D2 Dense # Print the L<parse|/parse> tree densely for reuse by computers rather than humans.
sub string($) #U Return a dense string representing a node of a L<parse|/parse> tree and all the nodes below it. Or use L<-s|/opString> B<$node>.
{my ($node) = @_; # Start node.
return $node->{text} if $node->{tag} eq cdata; # Text node
my $content = $node->content; # Sub nodes
my $attr = keys %{$node->{attributes}}; # Number of attributes
return '<'.$node->{tag}. '/>'
if !@$content and !keys %{$node->{attributes}}; # No sub nodes or attributes
return '<'.$node->{tag}.$node->printAttributes.'/>'
if !@$content; # No sub nodes
join '', '<', $node->{tag}, $node->printAttributes, '>', # Has sub nodes
(map {$_->{tag} eq cdata ? $_->{text} : $_->string} @$content), # Recurse to get the sub content
'</', $node->{tag}, '>'
}
sub stringAsMd5Sum($) #U Return the L<md5> of the dense L<string|/string> representing a node of a L<parse|/parse> tree minus its L<id> and all the nodes below it. Or use L<-g|/opString> B<$no...
{my ($node) = @_; # Node.
$node->id = undef if my $i = $node->id; # Save id
my $md5 = stringMd5Sum($node->string); # Md5 sum of string content minus id. The various printing methods will of course all produce different md5 sums but the md5 sum is big enough to accommodate the variatio...
$node->id = $i if $i; # Restore id if present
$md5 # Return md5 sum
}
sub stringQuoted($) #U Return a quoted string representing a L<parse|/parse> tree a node of a L<parse|/parse> tree and all the nodes below it. Or use L<-o|/opString> B<$node>.
{my ($node) = @_; # Start node
"'".$node->string."'"
}
sub stringReplacingIdsWithLabels($) # Return a string representing the specified L<parse|/parse> tree with the id attribute of each node set to the L<Labels|/Labels> attached to each node.
{my ($node) = @_; # Start node.
return $node->text if $node->isText; # Text node
my $t = $node->tag; # Not text so it has a tag
my $content = $node->content; # Sub nodes
return '<'.$t.$node->printAttributesReplacingIdsWithLabels.'/>' if !@$content;# No sub nodes
my $s = '<'.$t.$node->printAttributesReplacingIdsWithLabels.'>'; # Has sub nodes
$s .= $_->stringReplacingIdsWithLabels for @$content; # Recurse to get the sub content
return $s.'</'.$t.'>';
}
sub stringExtendingIdsWithLabels($) # Return a string representing the specified L<parse|/parse> tree with the id attribute of each node extended by the L<Labels|/Labels> attached to each node.
{my ($node) = @_; # Start node.
return $node->text if $node->isText; # Text node
my $t = $node->tag; # Not text so it has a tag
my $content = $node->content; # Sub nodes
return '<'.$t.$node->printAttributesExtendingIdsWithLabels.'/>' if !@$content;# No sub nodes
my $s = '<'.$t.$node->printAttributesExtendingIdsWithLabels.'>'; # Has sub nodes
$s .= $_->stringExtendingIdsWithLabels for @$content; # Recurse to get the sub content
return $s.'</'.$t.'>';
}
sub stringContent($) #U Return a string representing all the nodes below a node of a L<parse|/parse> tree.
{my ($node) = @_; # Start node.
my $s = '';
$s .= $_->string for $node->contents; # Recurse to get the sub content
$s
}
sub stringContentOrText($) #U Return a string representing all the nodes below a node of a L<parse|/parse> tree or the text of the current node if it is a text node.
{my ($node) = @_; # Start node.
return $node->text if $node->isText;
stringContent($node);
}
sub stringNode($) #U Return a string representing the specified B<$node> showing the attributes, labels and node number.
{my ($node) = @_; # Node.
my $s = '';
if ($node->isText) # Text node
{$s = 'CDATA='.$node->text;
}
lib/Data/Edit/Xml.pm view on Meta::CPAN
{my ($child, $parent, @context) = @_; # Child, parent, optional context
return undef if @context and !$child->at(@context); # Check context
return $child if $child->parent == $parent; # Check child has the parent as its parent
undef # Wrong parent
}
sub succeedingSiblingOf($$@) #C Returns the specified B<$child> node if it has the same parent as B<$sibling> and occurs after B<$sibling> and has the optionally specified context else returns B<unde...
{my ($child, $sibling, @context) = @_; # Child, sibling thought to occur before child, optional context
return undef if @context and !child->at(@context); # Check context
return undef unless $child->parent == $sibling->parent; # Check child has the parent as its prior sibling
$child->after($sibling); # Check child occurs after prior sibling
}
sub precedingSiblingOf($$@) #C Returns the specified B<$child> node if it has the same parent as B<$sibling> and occurs before B<$sibling> and has the optionally specified context else returns B<und...
{my ($child, $sibling, @context) = @_; # Child, sibling thought to occur after child, optional context
return undef if @context and !child->at(@context); # Check context
return undef unless $child->parent == $sibling->parent; # Check child has the parent as its prior sibling
$child->before($sibling); # Check child occurs after prior sibling
}
#D1 Navigation # Move around in the L<parse|/parse> tree.
sub go($@) #IYU Return the node reached from the specified B<$node> via the specified L<path|/path>: (index positionB<?>)B<*> where index is the tag of the next node to be chosen an...
{my ($node, @path) = @_; # Node, search specification.
my $p = $node; # Current node
while(@path) # Position specification
{my $i = shift @path; # Index name
return undef unless $p; # There is no node of the named type under this node
reindexNode($p); # Create index for this node
my $q = $p->indexes->{$i}; # Index
return undef unless defined $q; # Complain if no such index
if (@path) # Position within index
{if ($path[0] =~ /\A([-+]?\d+)\Z/) # Numeric position in index from start
{shift @path;
$p = $q->[$1]
}
elsif (@path == 1 and $path[0] =~ /\A\*\Z/) # Final index wanted
{return @$q;
}
else {$p = $q->[0]} # Step into first sub node by default
}
else {$p = $q->[0]} # Step into first sub node by default on last step
}
$p
}
#a up
#b <b><c/><c><d/><d/><d/><d/></c><c/></b>
#c go c 1 d 2
#c set id arrived_here
#d Follow a path from the current node.
sub c($$) #U Return an array of all the nodes with the specified tag below the specified B<$node>.
{my ($node, $tag) = @_; # Node, tag.
reindexNode($node); # Create index for this node
my $c = $node->indexes->{$tag}; # Index for specified tags
$c ? @$c : () # Contents as an array
}
sub cText($) #U Return an array of all the text nodes immediately below the specified B<$node>.
{my ($node) = @_; # Node.
reindexNode($node); # Create index for this node
$node->c(cdata); # Index for text data
}
sub findById($$) #U Find a node in the parse tree under the specified B<$node> with the specified B<$id>.
{my ($node, $id) = @_; # Parse tree, id desired.
my $i; # Node found
eval {$node->by(sub # Look for an instance of such a node
{if ($_->idX eq $id) {$i = $_; die} # Found the node - die to stop the search from going further
})};
$i # Node found if any
}
sub matchesNode($$@) # Return the B<$first> node if it matches the B<$second> node's tag and the specified B<@attributes> else return B<undef>.
{my ($first, $second, @attributes) = @_; # First node, second node, attributes to match on
return undef unless -t $first eq -t $second; # Check tags match
my $f = $first->attributes; # Attributes for first node
my $s = $second->attributes; # Attributes for second node
for my $a(@attributes)
{return undef unless defined($f->{$a}) and defined($s->{$a}) and
$f->{$a} eq $s->{$a};
}
$first # Nodes match on specified attributes
}
sub matchesSubTree($$@) # Return the B<$first> node if it L<matches|/matchesNode> the B<$second> node and the nodes under the first node match the corresponding nodes under the second node, else...
{my ($first, $second, @attributes) = @_; # First node, second node, attributes to match on
return undef unless &matchesNode(@_); # Check nodes match
my @f = @$first; # Children for first node
my @s = @$second; # Children for second node
return undef unless @f == @s; # Wrong number of children
while(@f) # Match each child
{return undef unless (shift @f)->matchesNode(shift @s, @attributes); # Children match
}
$first # Sub trees match
}
sub findMatchingSubTrees($$@) # Find nodes in the parse tree whose sub tree matches the specified B<$subTree> excluding any of the specified B<$attributes>.
{my ($node, $subTree, @attributes) = @_; # Parse tree, parse tree to match, attributes to match on
my @i; # Node found
my $t = -t $subTree; # Quick reject
$node->by(sub # Each node in the tree
{return unless -t $_ eq $t; # Quick reject
push @i, $_ if $_->matchesSubTree($subTree, @attributes); # Found a matching sub tree
});
@i # Node found if any
}
#D2 First # Find nodes that are first amongst their siblings.
sub first($@) #BCYU Return the first node below the specified B<$node> optionally checking the first node's context. See L<addFirst|/addFirst> to ensure that an expected node is in po...
{my ($node, @context) = @_; # Node, optional context.
return $node->content->[0] unless @context; # Return first node if no context specified
my ($c) = $node->contents; # First node
$c ? $c->at(@context) : undef; # Return first node if in specified context
}
#a
#b <b><c/></b><b><d/></b>
#c at b
#c first c
#c set id firstChild
#d Go to our first child optionally checking its context.
lib/Data/Edit/Xml.pm view on Meta::CPAN
{my ($node, @context) = @_; # Node, optional context.
return undef if @context and !$node->at(@context); # Optionally check the context
join '', map {' '.$_->tag.' '} $node->contentAfter
}
sub contentBeforeAsTags($@) #KU Return a string containing the tags of all the sibling nodes preceding the specified B<$node> separated by single spaces or the empty string if the node is empty or B...
{my ($node, @context) = @_; # Node, optional context.
return undef if @context and !$node->at(@context); # Optionally check the context
join ' ', map {$_->tag} $node->contentBefore
}
sub contentBeforeAsTags2($@) #KU Return a string containing the tags of all the sibling nodes preceding the specified B<$node> separated by two spaces with a single space preceding the first tag and ...
{my ($node, @context) = @_; # Node, optional context.
return undef if @context and !$node->at(@context); # Optionally check the context
join '', map {' '.$_->tag.' '} $node->contentBefore
}
sub position($) #U Return the index of the specified B<$node> in the content of the parent of the B<$node>.
{my ($node) = @_; # Node.
my @c = $node->parent->contents; # Each node in parent content
for(keys @c) # Test each node
{return $_ if $c[$_] == $node; # Return index position of node which counts from zero
}
confess "Node not found in parent"; # Something wrong with parent/child relationship
}
sub index($) #U Return the index of the specified B<$node> in its parent index. Use L<position|/position> to find the position of a node under its parent.
{my ($node) = @_; # Node.
my $p = $node->parent; # Parent
$p or confess "Cannot find index of root node"; # Complain if we try to find the index of the root node
if (my @c = $p->c($node->tag)) # Each node in parent index
{for(keys @c) # Test each node
{return $_ if $c[$_] == $node; # Return index position of node which counts from zero
}
}
confess "Node not found in parent"; # Something wrong with parent/child relationship
}
sub present($@) #U 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 ...
{my ($node, @names) = @_; # Node, possible tags immediately under the node.
reindexNode($node); # Create index for this node
my %i = %{$node->indexes}; # Index of child nodes
return map {$_=>scalar @{$i{$_}}} keys %i unless @names; # Hash of all names
grep {$i{$_}} @names # Count of tag types present
}
sub editText($@) :lvalue #C Return the text of a text B<$node> as an lvalue string reference that can be modified by a regular expression, else as a reference to a dummy string that will be ignor...
{my ($node, @context) = @_; # Node to test, optional context
my $dummy = ""; # An empty string reference
return $dummy if @context and !$node->at(@context); # Not in specified context
return $node->text if $node->isText; # Return reference to text if on a text node
$dummy # Nor on a text node
}
sub isText($@) #UCY Return the specified B<$node> if the specified B<$node> is a text node, optionally in the specified context, else return B<undef>.
{my ($node, @context) = @_; # Node to test, optional context
if (@context) # Optionally check context
{my $p = $node->parent; # Parent
return undef if !$p or !$p->at(@context); # Parent must match context
}
$node->tag eq cdata ? $node : undef
}
sub isFirstText($@) #UCY Return the specified B<$node> if the specified B<$node> is a text node, the first node under its parent and that the parent is optionally in the specified context, e...
{my ($node, @context) = @_; # Node to test, optional context for parent
return undef unless $node->isText(@context) and $node->isFirst; # Check that this node is a text node, that it is first, and, optionally check context of parent
$node # Return the node as it passes all tests
}
sub isLastText($@) #UCY Return the specified B<$node> if the specified B<$node> is a text node, the last node under its parent and that the parent is optionally in the specified context, el...
{my ($node, @context) = @_; # Node to test, optional context for parent
return undef unless $node->isText(@context) and $node->isLast; # Check that this node is a text node, that it is last, and, optionally check context of parent
$node # Return the node as it passes all tests
}
sub matchTree($@) #UC Return a list of nodes that match the specified tree of match expressions, else B<()> if one or more match expressions fail to match nodes in the tree below the speci...
{my ($node, @match) = @_; # Node to start matching from, tree of match expressions.
my ($tag, @S) = @match; # Tag we must match, sub tag specifications
my @nodes; # Matching nodes
return () unless atPositionMatch(-t $node, $tag); # Match tag of node
push @nodes, $node; # The current node matches so save it
if (my @s = map{ref($_) ? $_ : [$_]} @S) # Wrap sub tags that are not references with [] so that the caller does not have to because it is a bit tedious wrapping each word in quotes and [] brackets.
{my @c = $node->contents; # Contents of node
return () unless @s <= @c; # Confirm that there is a node to match against for each match expression
for my $c(@c) # Confirm each sub tag matches its sub tag expression
{push @nodes, my @m = $c->matchTree(@{shift @s}); # Save sub match
return () unless @m; # No sub match so return an empty list
}
}
@nodes # The nodes that matched each match expression
}
sub matchesText($$@) #UC Returns an array of regular expression matches in the text of the specified B<$node> if it is text node and it matches the specified regular expression and optionally...
{my ($node, $re, @context) = @_; # Node to test, regular expression, optional context
return () unless $node->isText(@context); # Check that this is a text node
$node->text =~ m($re); # Return array of matches - do not add 'g' as a modifier to the regular expression as the pos() feature of Perl regular expressions will then cause matches to fail that o...
}
sub isBlankText($@) #UCY Return the specified B<$node> if the specified B<$node> is a text node, optionally in the specified context, and contains nothing other than white space else return ...
{my ($node, @context) = @_; # Node to test, optional context
return undef if @context and !$node->at(@context); # Optionally check context
$node->isText && $node->text =~ /\A\s*\Z/s ? $node : undef
}
sub isAllBlankText($@) #UCY Return the specified B<$node> if the specified B<$node>, optionally in the specified context, does not contain anything or if it does contain something it is all whi...
{my ($node, @context) = @_; # Node to test, optional context
return undef if @context and !$node->at(@context); # Optionally check context
if ($node->isText) # If this is a text node test the text of the node
{return $node->text =~ m(\A\s*\Z)s ? $node : undef;
}
my @c = $node->contents;
return $node if @c == 0; # No content
return undef if @c > 1; # Content other than text (adjacent text elements are merged so there can only be one)
$node->stringContent =~ m(\A\s*\Z)s ? $node : undef
}
sub isOnlyChildBlankText($@) #UC Return the specified B<$node> if it is a blank text node and an only child else return B<undef>.
{my ($node, @context) = @_; # Node to test, optional context
return undef unless &isOnlyChildText(@_); # Confirm that this is an only text child
$node->text =~ m(\A\s*\Z)s; # All blank
}
lib/Data/Edit/Xml.pm view on Meta::CPAN
L<unwrap($node, @context)|/unwrap($node, @context)>
Unwrap the specified B<$node> if in the optional B<@context> by replacing the node with its contents. Returns the parent node on success, otherwise B<undef> if an attempt is made to unwrap a text node or the root node.
L<wrapWith($node, $tag, @context)|/wrapWith($node, $tag, @context)>
Wrap the specified B<$node> in a new node created from the specified B<$tag> in the optional B<@context> forcing the specified $node down to deepen the L<parse|/parse> tree - return the new wrapping node or B<undef> if this is not possible. See L<add...
=head1 Construction
Create a parse tree, either by parsing a L<file or string|/file or string> B<or> L<node by node|/Node by Node> B<or> from another L<parse tree|/Parse tree>.
=head2 File or String
Construct a parse tree from a file or a string.
=head3 new($fileNameOrString, @options)
Create a new parse tree - call this method statically as in Data::Edit::Xml::new(file or string) to parse a file or string B<or> with no parameters and then use L</input>, L</inputFile>, L</inputString>, L</errorFile> to provide specific parameters ...
Parameter Description
1 $fileNameOrString Optional file name or string from which to construct the parse tree
2 @options Hash of other options.
B<Example:>
my $a = Data::Edit::Xml::new(<<END); # ð—˜ð˜…ð—®ð—ºð—½ð—¹ð—²
<a>
<b>
<c id="42" match="mm"/>
</b>
<d>
<e/>
</d>
</a>
END
ok -p $a eq <<END;
<a>
<b>
<c id="42" match="mm"/>
</b>
<d>
<e/>
</d>
</a>
END
This is a static method and so should either be imported or invoked as:
Data::Edit::Xml::new
=head3 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<confess|http://perldoc.perl.org/Carp.html#SYNOPSIS/>.
B<Example:>
ok Data::Edit::Xml::cdata eq q(CDATA); # ð—˜ð˜…ð—®ð—ºð—½ð—¹ð—²
=head3 parse($parser)
Parse input L<Xml|https://en.wikipedia.org/wiki/XML> specified via: L<inputFile|/inputFile>, L<input|/input> or L<inputString|/inputString>.
Parameter Description
1 $parser Parser created by L</new>
B<Example:>
my $x = Data::Edit::Xml::new;
$x->inputString = <<END;
<a id="aa"><b id="bb"><c id="cc"/></b></a>
END
$x->parse; # ð—˜ð˜…ð—®ð—ºð—½ð—¹ð—²
ok -p $x eq <<END;
<a id="aa">
<b id="bb">
<c id="cc"/>
</b>
</a>
END
=head2 Node by Node
Construct a parse tree node by node.
=head3 newText(undef, $text)
Create a new text node.
Parameter Description
1 undef Any reference to this package
2 $text Content of new text node
B<Example:>
ok -p $x eq <<END;
<a class="aa" id="1">
<b class="bb" id="2"/>
</a>
END
$x->putLast($x->newText("t")); # ð—˜ð˜…ð—®ð—ºð—½ð—¹ð—²
ok -p $x eq <<END;
<a class="aa" id="1">
<b class="bb" id="2"/>
lib/Data/Edit/Xml.pm view on Meta::CPAN
The labels attached to a node to provide addressability from other nodes, see: L</Labels>.
=head4 lang
Attribute B<lang> for a node as an L<lvalue method|http://perldoc.perl.org/perlsub.html#Lvalue-subroutines> B<sub>. Use B<langX()> to return B<q()> rather than B<undef>.
=head4 lineNumbers
If true then save the line number.column number at which tag starts and ends on the xtrf attribute of each node.
=head4 navtitle
Attribute B<navtitle> for a node as an L<lvalue method|http://perldoc.perl.org/perlsub.html#Lvalue-subroutines> B<sub>. Use B<navtitleX()> to return B<q()> rather than B<undef>.
=head4 number
Number of the specified B<$node>, see L<findByNumber|/findByNumber>.
=head4 numbering
Last number used to number a node in this L<parse|/parse> tree.
=head4 numbers
Nodes by number.
=head4 otherprops
Attribute B<otherprops> for a node as an L<lvalue method|http://perldoc.perl.org/perlsub.html#Lvalue-subroutines> B<sub>. Use B<otherpropsX()> to return B<q()> rather than B<undef>.
=head4 outputclass
Attribute B<outputclass> for a node as an L<lvalue method|http://perldoc.perl.org/perlsub.html#Lvalue-subroutines> B<sub>. Use B<outputclassX()> to return B<q()> rather than B<undef>.
=head4 parent
Parent node of the specified B<$node> or B<undef> if the L<parser|/parse> root node. See also L</Traversal> and L</Navigation>. Consider as read only.
=head4 parser
L<Parser|/parse> details: the root node of a tree is the L<parser|/parse> node for that tree. Consider as read only.
=head4 props
Attribute B<props> for a node as an L<lvalue method|http://perldoc.perl.org/perlsub.html#Lvalue-subroutines> B<sub>. Use B<propsX()> to return B<q()> rather than B<undef>.
=head4 representationLast
The last representation set for this node by one of: L<setRepresentationAsTagsAndText|/setRepresentationAsTagsAndText>.
=head4 style
Attribute B<style> for a node as an L<lvalue method|http://perldoc.perl.org/perlsub.html#Lvalue-subroutines> B<sub>. Use B<styleX()> to return B<q()> rather than B<undef>.
=head4 tag
Tag name for the specified B<$node>, see also L</Traversal> and L</Navigation>. Consider as read only.
=head4 text
Text of the specified B<$node> but only if it is a text node otherwise B<undef>, i.e. the tag is cdata() <=> L</isText> is true.
=head4 type
Attribute B<type> for a node as an L<lvalue method|http://perldoc.perl.org/perlsub.html#Lvalue-subroutines> B<sub>. Use B<typeX()> to return B<q()> rather than B<undef>.
=head4 xtrc
Attribute B<xtrc> for a node as an L<lvalue method|http://perldoc.perl.org/perlsub.html#Lvalue-subroutines> B<sub>. Use B<classX()> to return B<q()> rather than B<undef>.
=head4 xtrf
Attribute B<xtrf> for a node as an L<lvalue method|http://perldoc.perl.org/perlsub.html#Lvalue-subroutines> B<sub>. Use B<classX()> to return B<q()> rather than B<undef>.
=head2 Data::Edit::Xml::Example Definition
Description of a pcd method
=head3 Output fields
=head4 also
See also
=head4 before
Before file content minus root tag which will be added as <a>
=head4 code
Pcd code
=head4 doc
One line summary
=head4 method
Method
=head2 Data::Edit::Xml::Table::Statistics Definition
Statistics about a table
=head3 Output fields
=head4 colSpec
lib/Data/Edit/Xml.pm view on Meta::CPAN
31 L<atText|/atText> - Confirm that we are on a text node whose text value matches a regular expression in the optional B<@context>.
32 L<atTop|/atTop> - Return the current node if it is the root == top of a parse tree else return B<undef>.
33 L<attr|/attr> - Return the value of an attribute of the current node as an L<lvalue method|http://perldoc.perl.org/perlsub.html#Lvalue-subroutines> B<sub>.
34 L<attrAt|/attrAt> - Return the specified B<$node> if it has the specified B<$attribute> and the $node is in the optional B<@context> else return B<undef>.
35 L<attrCount|/attrCount> - Return the number of attributes in the specified B<$node>, optionally ignoring the specified names from the count.
36 L<attrs|/attrs> - Return the values of the specified attributes of the current node as a list
37 L<attrsNone|/attrsNone> - Check that the specified B<$node> has no attributes.
38 L<attrValueAt|/attrValueAt> - Return the specified B<$node> if it has the specified B<$attribute> with the specified B<$value> and the $node is in the optional B<@context> else return B<undef>.
39 L<attrX|/attrX> - Return the value of the specified B<$attribute> of the specified B<$node> or B<q()> if the B<$node> does not have such an attribute.
40 L<AUTOLOAD|/AUTOLOAD> - Allow methods with constant parameters to be called as B<method_p1_p2>.
41 L<before|/before> - Return the first node if it occurs before the second node in the L<parse|/parse> tree optionally checking that the first node is in the specified context or else B<undef> if the node is L<above|/above>, L<below|/below> or L<bef...
42 L<below|/below> - Return the first node if the first node is below the second node optionally checking that the first node is in the specified context otherwise return B<undef>
43 L<belowPath|/belowPath> - Return the nodes along the path from the first node up to the second node when the first node is below the second node else return B<()>.
44 L<bitsNodeTextBlank|/bitsNodeTextBlank> - Return a bit string that shows if there are any non text nodes, text nodes or blank text nodes under a node.
45 L<breakIn|/breakIn> - Concatenate the nodes following and preceding the start node, unwrapping nodes whose tag matches the start node and return the start node.
46 L<breakInBackwards|/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<breakIn|/breakIn>.
47 L<breakInForwards|/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<breakIn|/breakIn>.
48 L<breakOut|/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.
49 L<breakOutChild|/breakOutChild> - Lift the specified B<$node> up one level splitting its parent.
50 L<by|/by> - Post-order traversal of a L<parse|/parse> tree or sub tree calling the specified B<sub> at each node and returning the specified starting node.
51 L<by2|/by2> - Post-order traversal of a L<parse|/parse> tree
52 L<By22|/By22> - Post-order traversal of a L<parse|/parse> tree or sub tree calling the specified B<sub> at each node and returning the specified starting node.
53 L<byList|/byList> - Return a list of all the nodes at and below a specified B<$node> in post-order or the empty list if the B<$node> is not in the optional B<@context>.
54 L<byReverse|/byReverse> - Reverse post-order traversal of a L<parse|/parse> tree or sub tree calling the specified B<sub> at each node and returning the specified starting B<$node>.
55 L<byReverseList|/byReverseList> - Return a list of all the nodes at and below a specified B<$node> in reverse preorder or the empty list if the specified B<$node> is not in the optional B<@context>.
56 L<byReverseX|/byReverseX> - Reverse post-order traversal of a L<parse|/parse> tree or sub tree below the specified B<$node> calling the specified B<sub> within L<eval|http://perldoc.perl.org/functions/eval.html>B<{}> at each node and returning the...
57 L<byX|/byX> - Post-order traversal of a L<parse|/parse> tree calling the specified B<sub> at each node as long as this sub does not L<die|http://perldoc.perl.org/functions/die.html>.
58 L<byX2|/byX2> - Post-order traversal of a L<parse|/parse> tree or sub tree calling the specified B<sub> within L<eval|http://perldoc.perl.org/functions/eval.html>B<{}> at each node and returning the specified starting node.
59 L<byX22|/byX22> - Post-order traversal of a L<parse|/parse> tree or sub tree calling the specified B<sub> within L<eval|http://perldoc.perl.org/functions/eval.html>B<{}> at each node and returning the specified starting node.
60 L<c|/c> - Return an array of all the nodes with the specified tag below the specified B<$node>.
61 L<cdata|/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<confess|http://perldoc.perl.org/Carp.html#SYNOPSIS/>.
62 L<change|/change> - Change the name of the specified B<$node>, optionally confirming that the B<$node> is in a specified context and return the B<$node>.
63 L<changeAttr|/changeAttr> - Rename attribute B<$old> to B<$new> in the specified B<$node> with optional context B<@context> unless attribute B<$new> is already set and return the B<$node>.
64 L<changeAttributeValue|/changeAttributeValue> - Apply a sub to the value of an attribute of the specified B<$node>.
65 L<changeAttrValue|/changeAttrValue> - Rename attribute B<$old> to B<$new> with new value B<$newValue> on the specified B<$node> in the optional B<@context> unless attribute B<$new> is already set or the value of the B<$old> attribute is not B<$old...
66 L<changeKids|/changeKids> - Change the names of all the immediate children of the specified B<$node>, if they match the optional B<@context>, to the specified B<$tag> and return the B<$node>.
67 L<changeOrDeleteAttr|/changeOrDeleteAttr> - Rename attribute B<$old> to B<$new> in the specified B<$node> in the optional B<@context> unless attribute B<$new> is already set in which case delete attribute B<$old>.
68 L<changeOrDeleteAttrValue|/changeOrDeleteAttrValue> - Rename attribute B<$old> to B<$new> with new value B<$newValue> on the specified B<$node> in the optional B<@context> unless attribute B<$new> is already set or the value of the B<$old> attribu...
69 L<changeReasonCommentSelectionSpecification|/changeReasonCommentSelectionSpecification> - Provide a specification to select L<change reason comments|/crc> to be inserted as text into a L<parse|/parse> tree.
70 L<changeText|/changeText> - Change the content of the specified text B<$node> that matches a regular expression B<$rf> presented as a string to a string B<$rt> in the optional B<@context> and return the specified $node else return B<undef>.
71 L<changeTextToSpace|/changeTextToSpace> - Change each instance of the content of the specified text B<$node> that matches a regular expression B<$re> to one space and return the specified $node else return B<undef>.
72 L<checkAllPaths|/checkAllPaths> - Create a representation of all the paths permitted in a block of L<Xml|https://en.wikipedia.org/wiki/XML>.
73 L<checkParentage|/checkParentage> - Check the parent pointers are correct in a L<parse|/parse> tree.
74 L<checkParser|/checkParser> - Check that every node has a L<parse|/parse>r.
75 L<childOf|/childOf> - Returns the specified B<$child> node if it is a child of the specified B<$parent> node and the B<$child> node is in the specified optional context.
76 L<clone|/clone> - Return a clone of the entire L<parse|/parse> tree which is created using the fast L<Storable::dclone> method.
77 L<closestLocation|/closestLocation> - Return the nearest node with line number.
78 L<commonAdjacentAncestors|/commonAdjacentAncestors> - Given two nodes, find a pair of adjacent ancestral siblings if such a pair exists else return B<()>.
79 L<commonAncestor|/commonAncestor> - Find the most recent common ancestor of the specified nodes or B<undef> if there is no common ancestor.
80 L<concatenate|/concatenate> - Concatenate two successive nodes and return the B<$target> node.
81 L<concatenateSiblings|/concatenateSiblings> - Concatenate the nodes that precede and follow the specified B<$node> in the optioonal B<@context> as long as they have the same tag as the specified B<$node> and return the specified B<$node>.
82 L<condition|/condition> - Return the B<$node> if it has the specified B<$condition> and is in the optional B<@context>, else return B<undef>
83 L<containsSingleText|/containsSingleText> - Return the single text element below the specified B<$node> else return B<undef>.
84 L<contentAfter|/contentAfter> - Return a list of all the sibling nodes following the specified B<$node> or an empty list if the specified B<$node> is last or not in the optional B<@context>.
85 L<contentAfterAsTags|/contentAfterAsTags> - Return a string containing the tags of all the sibling nodes following the specified B<$node> separated by single spaces or the empty string if the node is empty or B<undef> if the node does not match th...
86 L<contentAfterAsTags2|/contentAfterAsTags2> - Return a string containing the tags of all the sibling nodes following the specified B<$node> separated by two spaces with a single space preceding the first tag and a single space following the last t...
87 L<contentAsTags|/contentAsTags> - Return a string containing the tags of all the child nodes of the specified B<$node> separated by single spaces or the empty string if the node is empty or B<undef> if the node does not match the optional context.
88 L<contentAsTags2|/contentAsTags2> - Return a string containing the tags of all the child nodes of the specified B<$node> separated by two spaces with a single space preceding the first tag and a single space following the last tag or the empty str...
89 L<contentBefore|/contentBefore> - Return a list of all the sibling nodes preceding the specified B<$node> (in the normal sibling order) or an empty list if the specified B<$node> is last or not in the optional B<@context>.
90 L<contentBeforeAsTags|/contentBeforeAsTags> - Return a string containing the tags of all the sibling nodes preceding the specified B<$node> separated by single spaces or the empty string if the node is empty or B<undef> if the node does not match ...
91 L<contentBeforeAsTags2|/contentBeforeAsTags2> - Return a string containing the tags of all the sibling nodes preceding the specified B<$node> separated by two spaces with a single space preceding the first tag and a single space following the last...
lib/Data/Edit/Xml.pm view on Meta::CPAN
}
if (1) #TnumberTree #TfindByNumber #Tnumber
{my $a = Data::Edit::Xml::new(<<END);
<a><b><c/></b><d><e/></d></a>
END
$a->numberTree;
ok -z $a eq <<END;
<a id="1">
<b id="2">
<c id="3"/>
</b>
<d id="4">
<e id="5"/>
</d>
</a>
END
ok -t $a->findByNumber_4 eq q(d);
ok $a->findByNumber_3__up__number == 2;
}
if (1) #Tup #Tupn #TupUntil #TupWhile
{my $a = Data::Edit::Xml::new(<<END);
<a><b><c><b><b><b><b><c/></b></b></b></b></c></b></a>
END
$a->numberTree;
ok -z $a eq <<END;
<a id="1">
<b id="2">
<c id="3">
<b id="4">
<b id="5">
<b id="6">
<b id="7">
<c id="8"/>
</b>
</b>
</b>
</b>
</c>
</b>
</a>
END
my $c = $a->findByNumber(8);
ok -t $c eq q(c);
ok $c->up_b__number == 7;
ok $c->upn_2__number == 6;
ok $c->upWhile_b__number == 4;
ok $c->upWhile_a_b__number == 4;
ok $c->upWhile_b_c__number == 2;
ok $c->upUntil__number == 8;
ok $c->upUntil_b_c__number == 4;
}
if (1) {
ok Data::Edit::Xml::cdata eq q(CDATA); #Tcdata
ok Data::Edit::Xml::replaceSpecialChars(q(<">)) eq q(<">); #TreplaceSpecialChars
ok Data::Edit::Xml::undoSpecialChars(q(<">)) eq q(<">); #TundoSpecialChars
}
if (1) { # Break in and out
my $A = Data::Edit::Xml::new("<a><b><d/><c/><c/><e/><c/><c/><d/></b></a>"); #TbreakOut
ok -p $A eq <<END;
<a>
<b>
<d/>
<c/>
<c/>
<e/>
<c/>
<c/>
<d/>
</b>
</a>
END
if (1)
{my $a = $A->clone;
$a->go(q(b))->breakOut($a, qw(d e)); #TbreakOut
ok -p $a eq <<END; #TbreakOut #TbreakIn
<a>
<d/>
<b>
<c/>
<c/>
</b>
<e/>
<b>
<c/>
<c/>
</b>
<d/>
</a>
END
$a->go(qw(b 1))->breakIn; #TbreakIn
ok -p $a eq <<END; #TbreakIn
<a>
<b>
<d/>
<c/>
<c/>
<e/>
<c/>
<c/>
<d/>
</b>
</a>
END
$a->go(q(b))->breakOut($a, qw(d e)); # Break backwards
ok -p $a eq <<END; #TbreakInBackwards
<a>
<d/>
<b>
( run in 2.346 seconds using v1.01-cache-2.11-cpan-9581c071862 )