Data-Edit-Xml

 view release on metacpan or  search on metacpan

lib/Data/Edit/Xml.pm  view on Meta::CPAN

  return undef                                                                  # No such node
 }

sub firstInIndex($@)                                                            #CYU Return the specified B<$node> if it is first in its index and optionally L<at|/at> the specified context else B<undef>
 {my ($node, @context) = @_;                                                    # Node, optional context.
  return undef if @context and !$node->at(@context);                            # Check the context if supplied
  my $parent = $node->parent;                                                   # Parent
  return undef unless $parent;                                                  # The root node is not first in anything
  my @c = $parent->c($node->tag);                                               # Index containing node
  @c && $c[0] == $node ? $node : undef                                          # First in index ?
 }

sub firstOf($@)                                                                 #U Return an array of the nodes that are continuously first under their specified parent node and that match the specified list of tags.
 {my ($node, @tags) = @_;                                                       # Node, tags to search for.
  my %tags = map {$_=>1} @tags;                                                 # Hashify tags
  my @l;                                                                        # Matching last nodes
  for($node->contents)                                                          # Search through contents
   {return @l unless $tags{$_->tag};                                            # Nonmatching tag
    push @l, $_;                                                                # Save continuously matching tag in correct order
   }
  return @l                                                                     # All tags match
 }

sub firstWhile($@)                                                              #U Go first from the specified B<$node> and continue deeper firstly as long as each first child node matches one of the specified B<@tags>. Return the deepest such node e...
 {my ($node, @tags) = @_;                                                       # Node, tags to search for.
  my %tags = map {$_=>1} @tags;                                                 # Hashify tags
  my $p;                                                                        # Current position
  for(my $f = $node->first; $f and $tags{-t $f}; $f = $f->first) {$p = $f}      # Go ever firstly
  $p
 }

sub firstUntil($@)                                                              #CU Go first from the specified B<$node> and continue deeper firstly until a first child node matches the specified B<@context> or return B<undef> if there is no such nod...
 {my ($node, @context) = @_;                                                    # Node, context to search for.
  for(my $p = $node->first; $p; $p = $p->first)                                 # Check each first child node below the B<$node>
   {return $p if $p->at(@context);                                              # Return the node if it matches the specified context
   }
  undef
 }

sub firstUntilText($@)                                                          #CU Go first from the specified B<$node> and continue deeper firstly until a text node is encountered whose parent matches the specified B<@context> or return B<undef> if...
 {my ($node, @context) = @_;                                                    # Node, context to search for.
  for(my $p = $node->first; $p; $p = $p->first)                                 # Check each first child node below the B<$node>
   {return $p if $p->isText and $p->parent->at(@context);                       # Return the node if it is text and its parent matches the specified context
   }
  undef
 }

sub firstContextOf($@)                                                          #CYU Return the first node encountered in the specified context in a depth first post-order traversal of the L<parse|/parse> tree.
 {my ($node, @context) = @_;                                                    # Node, array of tags specifying context.
  my $x;                                                                        # Found node if found
  eval                                                                          # Trap the die which signals success
   {$node->by(sub                                                               # Traverse  L<parse|/parse> tree in depth first order
     {my ($o) = @_;
      if ($o->at(@context))                                                     # Does this node match the supplied context?
       {$x = $o;                                                                # Success
        die "success!";                                                         # Halt the search
       }
     });
   };
  confess $@ if $@ and  $@ !~ /success!/;                                       # Report any suppressed error messages at this point
  $x                                                                            # Return node found if we are still alive
 }

sub firstSibling($@)                                                            #CYU Return the first sibling of the specified B<$node> in the optional B<@context> else B<undef>
 {my ($node, @context) = @_;                                                    # Node, array of tags specifying context.
  return undef if @context and !$node->at(@context);                            # Not in specified context
  my $p = $node->parent;                                                        # Parent node
  $p->first                                                                     # Return first sibling
 }

#D2 Last                                                                        # Find nodes that are last amongst their siblings.

sub last($@)                                                                    #BCYU Return the last node below the specified B<$node> optionally checking the last node's context. See L<addLast|/addLast> to ensure that an expected node is in positio...
 {my ($node, @context) = @_;                                                    # Node, optional context.
  return $node->content->[-1] unless @context;                                  # Return last node if no context specified
  my ($c) = reverse $node->contents;                                            # Last node
  $c ? $c->at(@context) : undef;                                                # Return last node if in specified context
 }
#a
#b <b><c/><d/></b><b><c/></b>
#c   at b
#c   last d
#c   set id lastChild
#d Go to our last child optionally checking its context.

sub lastn($$@)                                                                  #CU Return the B<$n>'th last node below the specified B<$node> optionally checking its context or B<undef> if there is no such node.  B<lastn(1)> is identical in effect t...
 {my ($node, $N, @context) = @_;                                                # Node, number of times to go last, optional context.
  return undef if @context and !$node->at(@context);                            # Check the context if supplied
  for(1..$N)                                                                    # Go last the specified number of times
   {$node = $node->last;                                                        # Go last
    last unless $node;                                                          # Cannot go further
   }
  $node
 }

sub lastText($@)                                                                #CU Return the last node under the specified B<$node> if it is in the optional and it is a text node otherwise B<undef>.
 {my ($node, @context) = @_;                                                    # Node, optional context.
  return undef if @context and !$node->at(@context);                            # Check the context if supplied
  my $l = &last($node);                                                         # Last node
  $l ? $l->isText : undef                                                       # Test whether the first node exists and is a text node
 }

sub lastTextMatches($$@)                                                        #CU Return the last node under the specified B<$node> if: it is a text mode; its text matches the specified regular expression; the specified B<$node> is in the optional ...
 {my ($node, $match, @context) = @_;                                            # Node, regular expression the text must match, optional context of specified  node.
  return undef if @context and !$node->at(@context);                            # Check context
  if (my $t = $node->lastText)                                                  # Last node is text
   {return $t->matchesText($match);                                             # Last text node matches the specified regular expression
   }
  undef                                                                         # Last node is not text or does not match the specified regular expression
 }

sub lastBy($@)                                                                  #U Return a list of the last instance of each specified tag encountered in a post-order traversal from the specified B<$node> or a hash of all last instances if no tags a...
 {my ($node, @tags) = @_;                                                       # Node, tags to search for.
  my %tags;                                                                     # Tags found first
  $node->by(sub {$tags{$_->tag} = $_});                                         # Save last instance of each node
  return %tags unless @tags;                                                    # Return hash of all tags encountered last unless @tags filter was specified
  map {$tags{$_}} @tags;                                                        # Nodes in the requested order
 }

sub lastDown($@)                                                                #U Return a list of the last instance of each specified tag encountered in a pre-order traversal from the specified B<$node> or a hash of all last instances if no tags ar...
 {my ($node, @tags) = @_;                                                       # Node, tags to search for.
  my %tags;                                                                     # Tags found first
  $node->down(sub {$tags{$_->tag} = $_});                                       # Save last instance of each node
  return %tags unless @tags;                                                    # Return hash of all tags encountered last unless @tags filter was specified
  map {$tags{$_}} @tags;                                                        # Nodes in the requested order
 }

sub lastIn($@)                                                                  #YU Return the last child node matching one of the named tags under the specified parent node.
 {my ($node, @tags) = @_;                                                       # Parent node, child tags to search for.
  my %tags = map {$_=>1} @tags;                                                 # Hashify tags
  for(reverse $node->contents)                                                  # Search backwards through contents
   {return $_ if $tags{$_->tag};                                                # Find last tag with the specified name
   }
  return undef                                                                  # No such node
 }

sub lastNot($@)                                                                 #U Return the last child node that does not match any of the named B<@tags> under the specified parent B<$node>. Return B<undef> if there is no such child node.
 {my ($node, @tags) = @_;                                                       # Parent node, child tags to avoid.
  my %tags = map {$_=>1} @tags;                                                 # Hashify tags
  for(reverse $node->contents)                                                  # Search backwards through contents
   {return $_ unless $tags{$_->tag};                                            # Find last tag that fails to match
   }
  return undef                                                                  # No such node
 }

sub lastOf($@)                                                                  #U Return an array of the nodes that are continuously last under their specified parent node and that match the specified list of tags.
 {my ($node, @tags) = @_;                                                       # Node, tags to search for.
  my %tags = map {$_=>1} @tags;                                                 # Hashify tags
  my @l;                                                                        # Matching last nodes
  for(reverse $node->contents)                                                  # Search backwards through contents
   {return @l unless $tags{$_->tag};                                            # Nonmatching tag
    unshift @l, $_;                                                             # Save continuously matching tag in correct order
   }
  return
   @l                                                                           # All tags match
 }

sub lastInIndex($@)                                                             #CYU Return the specified B<$node> if it is last in its index and optionally L<at|/at> the specified context else B<undef>
 {my ($node, @context) = @_;                                                    # Node, optional context.
  return undef if @context and !$node->at(@context);                            # Check the context if supplied
  my $parent = $node->parent;                                                   # Parent
  return undef unless $parent;                                                  # The root node is not first in anything
  my @c = $parent->c($node->tag);                                               # Index containing node
  @c && $c[-1] == $node ? $node : undef                                         # Last in index ?
 }

sub lastContextOf($@)                                                           #CYU Return the last node encountered in the specified context in a depth first reverse pre-order traversal of the L<parse|/parse> tree.
 {my ($node, @context) = @_;                                                    # Node, array of tags specifying context.
  my $x;                                                                        # Found node if found
  eval                                                                          # Trap the die which signals success
   {$node->downReverse(sub                                                      # Traverse  L<parse|/parse> tree in depth first order
     {my ($o) = @_;
      if ($o->at(@context))                                                     # Does this node match the supplied context?
       {$x = $o;                                                                # Success
        die "success!";                                                         # Halt the search
       }
     });
   };
  confess $@ if $@ and  $@ !~ /success!/;                                       # Report any suppressed error messages at this point
  $x                                                                            # Return node found if we are still alive
 }

sub lastSibling($@)                                                             #CYU Return the last sibling of the specified B<$node> in the optional B<@context> else B<undef>
 {my ($node, @context) = @_;                                                    # Node, array of tags specifying context.
  return undef if @context and !$node->at(@context);                            # Not in specified context
  my $p = $node->parent;                                                        # Parent node
  $p->last                                                                      # Return last sibling
 }

sub lastWhile($@)                                                               #U Go last from the specified B<$node> and continue deeper lastly as long as each last child node matches one of the specified B<@tags>. Return the deepest such node enco...
 {my ($node, @tags) = @_;                                                       # Node, tags to search for.
  my %tags = map {$_=>1} @tags;                                                 # Hashify tags
  my $p;                                                                        # Current position
  for(my $l = $node->last; $l and $tags{-t $l}; $l = $l->first) {$p = $l}       # Go ever lastly
  $p
 }

sub lastUntil($@)                                                               #CU Go last from the specified B<$node> and continue deeper lastly until a last child node matches the specified B<@context> or return B<undef> if there is no such node. ...
 {my ($node, @context) = @_;                                                    # Node, context to search for.
  for(my $p = $node->last; $p; $p = $p->last)                                   # Check each last child node below the B<$node>
   {return $p if $p->at(@context);                                              # Return the node if it matches the specified context
   }
  undef
 }

sub lastUntilText($@)                                                           #CU Go last from the specified B<$node> and continue deeper lastly until a last child text node matches the specified B<@context> or return B<undef> if there is no such n...
 {my ($node, @context) = @_;                                                    # Node, context to search for.
  for(my $p = $node->last; $p; $p = $p->last)                                   # Check each last child node below the B<$node>
   {return $p if $p->isText and $p->parent->at(@context);                       # Return the node if it matches the specified context
   }
  undef
 }

#D2 Next                                                                        # Find sibling nodes after the specified B<$node>.

sub next($@)                                                                    #BCYU Return the node next to the specified B<$node>, optionally checking the next node's context. See L<addNext|/addNext> to ensure that an expected node is in position.
 {my ($node, @context) = @_;                                                    # Node, optional context.
  return undef if $node->isLast;                                                # No node follows the last node at a level or the top most node
  my @c = $node->parent->contents;                                              # Content array of parent
  while(@c)                                                                     # Test until no more nodes left to test
   {my $c = shift @c;                                                           # Each node
    if ($c == $node)                                                            # Current node
     {my $n = shift @c;                                                         # Next node
      return undef if @context and !$n->at(@context);                           # Next node is not in specified context
      return $n;                                                                # Found node
     }
   }
  confess "Node not found in parent";                                           # Something wrong with parent/child relationship
 }
#a isFirst
#b <b/><c/><b/><d/>
#c   at   b
#c   next c
#c   set id c_after_b
#d Go to the next sibling optionally checking its context.

sub nextn($$@)                                                                  #CU Return the B<$n>'th next node after the specified B<$node> optionally checking its context or B<undef> if there is no such node.  B<nextn(1)> is identical in effect t...
 {my ($node, $N, @context) = @_;                                                # Node, number of times to go next, optional context.
  return undef if @context and !$node->at(@context);                            # Check the context if supplied
  for(1..$N)                                                                    # Go next the specified number of times



( run in 0.900 second using v1.01-cache-2.11-cpan-39bf76dae61 )