Data-Edit-Xml
view release on metacpan or search on metacpan
lib/Data/Edit/Xml.pm view on Meta::CPAN
}
sub By22($$) #P 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. The B<sub> is passed re...
{my ($node, $sub) = @_; # Starting node, sub to call for each sub node
$node->by2($sub); # Recurse through nodes
$node
}
# Doubles performance of by! IT is tempting to think that removing all the parameters would speed things up a lot - it does not as most parse trees are not very deep.
sub by($$) #I 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. The B<sub> is passed re...
{my ($node, $sub) = @_; # Starting node, sub to call for each sub node
my $by; $by = sub # Recurse to process sub nodes in deeper context
{$_ = $_[0]; # Save active node in $_
if (my $c = $_->{content}) # Contents reference
{my @c = @$c; # For some reason we cannot place this directly in a for loop reliably
for(@c) # Each node under the current node
{if (my $d = $_->{content}) # Contents reference
{my @d = @$d; # Content
my $D = $_; # Save $_ so we can use it in the following loop
lib/Data/Edit/Xml.pm view on Meta::CPAN
confess "No parent" unless $p; # Not possible on a root node
my @c = $p->contents; # Content
shift @c while @c and $c[ 0] != $start; # Position on start node
if (@match) # Select matching nodes if requested
{my %m = map {$_=>1} @match;
return grep {$m{$_->tag}} @c;
}
@c # Elements in the specified range
}
sub to($@) # Return a list of the sibling nodes preceding the specified node optionally including only those nodes that match one of the tags in the specified list.
{my ($end, @match) = @_; # End node, optional list of tags to match
my $q = $end->parent; # Parent node
confess "No parent" unless $q; # Not possible on a root node
my @c = $q->contents; # Content
pop @c while @c and $c[-1] != $end; # Position on end
if (@match) # Select matching nodes if requested
{my %m = map {$_=>1} @match;
return grep {$m{$_->tag}} @c;
}
@c # Elements in the specified range
lib/Data/Edit/Xml.pm view on Meta::CPAN
return $tag eq $match unless ref $match; # Match scalar
return $tag =~ m($match)s if ref($match) =~ m(regexp)i; # Match regular expression
return $$match{$tag} if ref($match) =~ m(hash)i; # Match hash key
if (ref($match) =~ m(array)i) # Match array
{my %m = map {$_=>1} @$tag;
return $m{$tag}
}
confess "Unknown match type"; # Do not know how to match
}
sub at($@) #CIYU Confirm that the specified B<$node> has the specified L<ancestry|/ancestry>. Ancestry is specified by providing the expected tags that the B<$node>'s parent, the pa...
{my ($node, @context) = @_; # Node, ancestry.
for(my $x = shift @_; $x; $x = $x->parent) # Up through parents
{return $node unless @_; # OK if no more required context
next if atPositionMatch(-t $x, shift @_); # Match tag against context
return undef # Error if required does not match actual
}
!@_ ? $node : undef # Top of the tree is OK as long as there is no more required context
}
#b <b/>
#b <c/>
lib/Data/Edit/Xml.pm view on Meta::CPAN
reverse @p # Return path from root
}
sub pathString($) #bU Return a string representing the L<path|/path> to the specified B<$node> from the root of the parse tree.
{my ($node) = @_; # Node.
join ' ', path($node) # String representation
}
#D2 Match # Locate adjacent nodes that match horizontally and vertically
sub an($$@) #CU Return the next node if the specified B<$node> has the tag specified by B<$current> and the next node is in the specified B<@context>.
{my ($node, $current, @context) = @_; # Node, tag node must match, optional context of the next node.
return undef unless $node->at($current); # Check node has the right tag
$node->next(@context) # Next node if it matches the context else B<undef>
}
sub ap($$@) #CU Return the previous node if the specified B<$node> has the tag specified by B<$current> and the previous node is in the specified B<@context>.
{my ($node, $current, @context) = @_; # Node, tag node must match, optional context of the previous node.
return undef unless $node->at($current); # Check node has the right tag
$node->prev(@context) # Previous node if it matches the context else B<undef>
}
sub apn($$$@) #KU Return (previous node, next node) if the B<$previous> and B<$current> nodes have the specified tags and the next node is in the specified B<@context> else return B<()...
{my ($node, $prev, $current, @context) = @_; # Current node, tag for the previous node, tag for specified node, context for the next node.
return () if !@context or !$node->at($current) or # Check context
$node->isLast or $node->isFirst; # Check existence of surrounding nodes
my $p = $node->prev($prev); # Previous node
lib/Data/Edit/Xml.pm view on Meta::CPAN
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
lib/Data/Edit/Xml.pm view on Meta::CPAN
}
BEGIN {*root = *top}
#a
#b <b><c/></b>
#c top
#c set id top
#d Go to the top of the parse tree.
sub up($@) #CYU Return the parent of the current node optionally checking the parent node's context or return B<undef> if the specified B<$node> is the root of the L<parse|/parse> t...
{my ($node, @context) = @_; # Start node, optional context of parent.
return $node->parent unless @context; # Parent with no context check
my $p = $node->parent;
$p->at(@context) ? $p : undef; # Check context of parent
}
#a
#b <b><c/></b>
#c at c
#c up
#c set id above_c
lib/Data/Edit/Xml.pm view on Meta::CPAN
elsif (@path == 1 and $path[0] =~ /\A\*\Z/) # Final index wanted
{return [@p];
}
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] # Success!
}
sub nn($) #P Replace new lines in a string with N to make testing easier.
{my ($s) = @_; # String.
$s =~ s/\n/N/gsr
}
#D1 Validation # Validate Xml
sub checkAllPaths($) #S Create a representation of all the paths permitted in a block of L<xml>. The syntax of each line is a word representing an L<xml> tag followed by one of: tag B<1 * + ?...
{my ($valid) = @_; # Path descriptions
my %valid; # Perl representation of validating string
my @stack; # Tag stack
( run in 2.028 seconds using v1.01-cache-2.11-cpan-5b529ec07f3 )