#!/usr/bin/perl
#-------------------------------------------------------------------------------
# Edit data held in Xml format
# Philip R Brenan at gmail dot com, Appa Apps Ltd, 2016
#-------------------------------------------------------------------------------

package Data::Edit::Xml;
require v5.16.0;
use warnings FATAL => qw(all);
use strict;
use Carp;
use XML::Parser;                                                                # https://metacpan.org/pod/XML::Parser
use POSIX qw(strftime);                                                         # http://www.cplusplus.com/reference/ctime/strftime/
use Data::Table::Text qw(:all);
our $VERSION = 2017.109;

if (0)                                                                          # Save to S3:- this will not work, unless you're me, or you happen, to know the key
 {my $z = 'DataXmlEdit.zip';
  print for qx(zip $z $0 && aws s3 cp $z s3://AppaAppsSourceVersions/$z && rm $z);
 }

# Static initialization
my $userParametersTable = <<END;                                                # Parameters that the user can set
inputString a string of xml to be parsed
inputFile   a file of xml to be parsed
name        a symbolic name for this parse used in messages about this parse and to name output files generated by this parse
output      a directory into which to write output files
errors      a sub directory of 'output' into which to write a copy of the string to be parsed in the event that an xml parse error is encountered while parsing this string
END
our $userParametersIndent = ("\n"x2).indentString($userParametersTable, '  ');  # User settable parameters string for use in the documentation
my  $userParametersHash   = loadHashFromLines($userParametersTable);            # Parameters that the user can set

genLValueScalarMethodsWithDefaultValues(sort keys %$userParametersHash);        # Create methods for user settable parameters
genLValueScalarMethods(qw(parent parser tag text));                             # Parent node, parser details, tag name, text of text command
genLValueArrayMethods (qw(content));                                            # Content of command
genLValueHashMethods  (qw(attributes conditions indexes));                      # Attributes, conditional string, sub command indexes for each command

#1 Constructor
sub new                                                                         # New parse - call this method statically as in Data::Edit::Xml::new() with keyword parameters=> chosen from: $Data::Edit::Xml::userParametersIndent

 {my $x = {@_};                                                                 # Parameters chosen from user settable parameters
  my $p = $userParametersHash;
  checkKeys($x, $p);                                                            # Check parameters
  bless $x;                                                                     # Create xml editor
  $x->inputString || $x->inputFile or confess "inputString or inputFile parameter required";
  $x->parse;                                                                    # Parse
 }

sub cdata                                                                       # The name of the command name to use to represent text

 {'CDATA'
 }

sub badParseOutputFileName                                                      ## Output file name for file holding details of a failed parse
 {my ($p) = @_;                                                                 # Parser details
  $p->output.'/'.$p->errors.'/'.$p->name.".xml"                                 # File to write source xml into if a parsing error occurs
 }

sub parse($)
 {my ($p) = @_;                                                                 ## Parser details
  my $badFile = $p->badParseOutputFileName;                                     # File to write source xml into if a parsing error occurs
  unlink $badFile if -e $badFile;

  if ($p->inputString) {}                                                       # Parse a string
  elsif (my $f = $p->inputFile)                                                 # Parse a file
   {if (-e $f)                                                                  # Check file exists
     {$p->inputString = readFile($f);
     }
    else
     {confess "Input file to be parsed does not exist, file name is:\n$f";
     }
   }

  my $parser = new XML::Parser(Style => 'Tree');                                # Extend Larry Wall's excellent XML parser
  my $d = $p->inputString;                                                      # String to be parsed
  my $x = eval {$parser->parse($d)};                                            # Parse string
  if (!$x)
   {writeFile($badFile, "$d\n$@");                                              # Write an error files
    confess "Unable to parse the xml in file\n$badFile\n$@";                    # Complain helpfully if parse failed
   }
  $p->tree($x);                                                                 # Structure parse results as a tree
  if (my @c = @{$p->content})
   {confess "No xml" if !@c;
    confess "More than one outer-most tag" if @c > 1;
    my $c = $c[0];
    $p->tag        = $c->tag;
    $p->attributes = $c->attributes;
    $p->content    = $c->content;
    $p->parent     = undef;
    $p->indexNode;
   }
  $p
 }

sub tree($$$$)                                                                  ## Build a tree representation of the parsed 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 {};                                                        # 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/)
       {$s = replaceSpecialChars($s);
        $node->tag = cdata; $node->text = $s;                                   # Save text. ASSUMPTION: CDATA is not used as a tag anywhere.
        push @{$parent->content}, $node;                                        # Save on parents content list
       }
     }
    else                                                                        # Node
     {my $children   = shift @$parse;
      my $attributes = shift @$children;
      $node->tag = $tag; $node->attributes = $attributes;                       # Save tag and 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 indexNode($)                                                                ## 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 commands
    $n->parent = $node;                                                         # Point to parent
    $n->parser = $node->parser;                                                 # Point to parser
   }
 }

sub replaceSpecialChars($)                                                      ## Replace < and > with &lt; and &gt; in a string
 {my ($s) = @_;                                                                 # String
  $s =~ s/\</&lt;/gr =~ s/\>/&gt;/gr;                                           # Larry Wall's parser unfortunately replaces &lt and &gt with their expansions in text and does not seem to provide away to stop this behaviour, so we have to put them back
 }

#1 Stringification                                                              # Print the parse tree
sub string($)                                                                   # Build a string from a node of a parse tree and the nodes below it
 {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 commands
  return '<'.$t.$node->printAttributes.'/>' if !@$content;                      # No sub commands

  my $s = '<'.$t.$node->printAttributes.'>';                                    # Has sub commands
  $s .= $_->string for @$content;                                               # Recurse to get the sub content
  return $s.'</'.$t.'>';
 }

sub stringWithCondition($@)                                                     # Build a string from a node of a parse tree and the nodes below it subject to conditions to reject some nodes
 {my ($node, @conditions) = @_;                                                 # Start node, conditions in effect
  return $node->text if $node->isText;                                          # Text node
  my %c = %{$node->conditions};                                                 # Process conditions if any for this node
  return '' if keys %c and @conditions and !grep {$c{$_}} @conditions;          # Return if conditions are in effect and no conditions match
  my $t = $node->tag;                                                           # Not text so it has a tag
  my $content = $node->content;                                                 # Sub commands

  my $s = ''; $s .= $_->stringWithCondition(@conditions) for @$content;         # Recurse to get the sub content
  return '<'.$t.$node->printAttributes.'/>' if !@$content or $s =~ /\A\s*\Z/;   # No sub commands or none selected
  '<'.$t.$node->printAttributes.'>'.$s.'</'.$t.'>';                             # Has sub commands
 }

sub addConditions($@)                                                           # Add conditions to a node
 {my ($node, @conditions) = @_;                                                 # Node, conditions to add
  $node->conditions->{$_}++ for @conditions;
  $node
 }

sub deleteConditions($@)                                                        # Delete conditions applied to a node
 {my ($node, @conditions) = @_;                                                 # Node, conditions to add
  delete $node->conditions->{$_} for @conditions;
  $node
 }

sub listConditions($)                                                           # List conditions applied to a node
 {my ($node) = @_;                                                              # Node
  sort keys %{$node->conditions}
 }

sub isText($)                                                                   # Is this a text node?
 {my ($node) = @_;                                                              # Node to test
  $node->tag eq cdata
 }

sub printAttributes($)                                                          ## Print the attributes of a node
 {my ($node) = @_;                                                              # Node whose attributes are to be printed
  my $a = $node->attributes;                                                    # Attributes
  $$a{$_} ? undef : delete $$a{$_} for keys %$a;                                # Remove undefined attributes
  return '' unless keys %$a;                                                    # No attributes
  my $s = ' '; $s .= $_.'="'.$a->{$_}.'" ' for sort keys %$a; chop($s);         # Attributes enclosed in "" in alphabetical order
  $s
 }

#1 Attributes                                                                   # Get or set attributes
sub attr($$) :lvalue                                                            # Value of attribute in current command
 {my ($node, $attribute) = @_;                                                  # Node in parse tree, attribute name
  $node->attributes->{$attribute}
 }

for(qw(id href))                                                                # Well known attributes
 {eval 'sub '.$_.'($) :lvalue {&attr($_[0], qw('.$_.'))}';
  $@ and confess "Cannot create well known attribute $_\n$@";
 }

sub setAttr($$@)                                                                # Set the value of an attribute in a command
 {my ($node, %values) = @_;                                                     # Node in parse tree, (attribute name=>new value)*
  $node->attributes->{$_} = $values{$_} for keys %values;
  $node
 }

#1 Contents                                                                     # Contents of the current node
sub contents($)                                                                 # Get all the nodes contained by this node as an array (not an array reference)
 {my ($node) = @_;                                                              # Node
  @{$node->content}                                                             # Contents
 }

sub contentBeyond($)                                                            # Get all the nodes beyond this node at the level of this node
 {my ($node) = @_;                                                              # Node
  my $parent = $node->parent;                                                   # Parent
  return () if !$parent;                                                        # The uppermost node has no content beyond it
  my @c = $parent->contents;                                                    # Contents of parent
  while(@c)                                                                     # Test until no more nodes left to test
   {my $c = shift @c;                                                           # Position of current node
    return @c if $c == $node                                                    # Nodes beyond this node if it is the searched for node
   }
  confess "Node not found in parent";                                           # Something wrong with parent/child relationship
 }

sub contentBefore($)                                                            # Get all the nodes before this node at the level of this node
 {my ($node) = @_;                                                              # Node
  my $parent = $node->parent;                                                   # Parent
  return () if !$parent;                                                        # The uppermost node has no content beyond it
  my @c = $parent->contents;                                                    # Contents of parent
  while(@c)                                                                     # Test until no more nodes left to test
   {my $c = pop @c;                                                             # Position of current node
    return @c if $c == $node                                                    # Nodes beyond this node if it is the searched for node
   }
  confess "Node not found in parent";                                           # Something wrong with parent/child relationship
 }

sub contentAsTags($)                                                            # Get the tags of all the nodes contained by this node as a string
 {my ($node) = @_;                                                              # Node
  join ' ', map {$_->tag} $node->contents
 }

sub contentBeyondAsTags($)                                                      # Get the tags of all the nodes beyond this node as a string
 {my ($node) = @_;                                                              # Node
  join ' ', map {$_->tag} $node->contentBeyond
 }

sub contentBeforeAsTags($)                                                      # Get the tags of all the nodes before this node as a string
 {my ($node) = @_;                                                              # Node
  join ' ', map {$_->tag} $node->contentBefore
 }

sub position($)                                                                 # Find the position of a node in its parent's content
 {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
   }
  undef
 }

sub index($)                                                                    # Find the position of a node in its parent's index
 {my ($node) = @_;                                                              # Node
  if (my $c = $node->parent->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
     }
   }
  undef
 }

#1 Navigation                                                                   # Move around in the parse tree
sub context($)                                                                  # Tags of this node and its ancestors joined to make a string
 {my ($node) = @_;                                                              # Node
  my @a;                                                                        # Ancestors
  for(my $p = $node; $p; $p = $p->parent)
   {push @a, $p->tag;
    @a < 100 or confess "Overly deep tree!";
   }
  join ' ', @a
 }

sub get($@)                                                                     # Get a sub node under the current node by its position in each index with position zero assumed if no position is supplied
 {my ($node, @position) = @_;                                                   # Node, position specification: (index, position?)*
  my $p = $node;                                                                # Current node
  while(@position)                                                              # Position specification
   {my $i = shift @position;                                                    # Index name
    my $q = $p->indexes->{$i};                                                  # Index
    defined $i or confess 'No such index: $i';                                  # Complain if no such index
    if (@position)                                                              # Position within index
     {if ((my $n = $position[0]) =~ /\A\d+\Z/)                                  # Numeric position in index from start
       {shift @position;
        $p = $q->[$n]
       }
      elsif ($n =~ /\A-\d+\Z/)                                                  # Numeric position in index from end
       {shift @position;
        $p = $q->[-$n]
       }
      elsif ($n =~ /\A\*\Z/ and @position == 1)                                 # 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
 }

sub c($$$)                                                                      # Get all the nodes with the tag of the specified name below the current node
 {my ($node, $tag, $position) = @_;                                             # Node, tag
  $node->indexes->{$tag}                                                        # Index for specified tags
 }

sub first($)                                                                    # Get the first node below this node
 {my ($node) = @_;                                                              # Node
  $node->content->[0]
 }

sub last($)                                                                     # Get the last node below this node
 {my ($node) = @_;                                                              # Node
  $node->content->[-1]
 }

sub isFirst($)                                                                  # Is this node first under its parent?
 {my ($node) = @_;                                                              # Node
  my $parent = $node->parent;                                                   # Parent
  return 1 unless $parent;                                                      # The top most node is always first
  $node == $parent->first                                                       # First under parent
 }

sub isLast($)                                                                   # Is this node last under its parent?
 {my ($node) = @_;                                                              # Node
  my $parent = $node->parent;                                                   # Parent
  return 1 unless $parent;                                                      # The top most node is always last
  $node == $parent->last                                                        # Last under parent
 }

sub isOnlyChild($)                                                              # Is this the only child of its parent?
 {my ($node) = @_;                                                              # Node
  $node->isFirst and $node->isLast
 }

sub next($)                                                                     # Get the node next to the current node
 {my ($node) = @_;                                                              # Node
  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
    return shift @c if $c == $node                                              # Next node if this is the current node
   }
  confess "Node not found in parent";                                           # Something wrong with parent/child relationship
 }

sub prev($)                                                                     # Get the node previous to the current node
 {my ($node) = @_;                                                              # Node
  return undef if $node->isFirst;                                               # No node precedes the first 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 = pop @c;                                                             # Each node
    return pop @c if $c == $node                                                # Previous node if this is the current node
   }
  confess "Node not found in parent";                                           # Something wrong with parent/child relationship
 }

sub by($$;@)                                                                    # Post-order traversal of a parse tree or sub tree - based on experience this is the most useful way to process xml documents
 {my ($node, $sub, @context) = @_;                                              # Starting node, sub to call for each sub node, accumulated context
  my @n = $node->contents;                                                      # Clone the content array so that the tree can be modified if desired
  $_->by($sub, $node, @context) for @n;                                         # Recurse to process sub nodes in deeper context
  &$sub($node, @context);                                                       # Process current node last
  $node
 }

sub at($$@)                                                                     # Check the node is in the context specified by the array of tags from the ancestors going up the parse tree from the node

 {for(my $x = shift @_; $x; $x = $x->parent)                                    # Up through parents
   {return 1 unless @_;                                                         # OK if no more required context
    next if shift @_ eq $x->tag;                                                # Carry on if contexts match
    return 0                                                                    # Error if required does not match actual
   }
  !@_                                                                           # Top of the tree is OK as long as there is no more required context
 }

sub over($$)                                                                    # Match the tags at the level below a node against a regular expression
 {my ($node, $re) = @_;                                                         # Node, regular expression
  $node->contentAsTags =~ m/$re/
 }

sub after($$)                                                                   # Match the tags in the current level after a node against a regular expression
 {my ($node, $re) = @_;                                                         # Node, regular expression
  $node->contentBeyondAsTags =~ m/$re/
 }

sub before($$)                                                                  # Match the tags in the current level before a node against a regular expression
 {my ($node, $re) = @_;                                                         # Node, regular expression
  $node->contentBeforeAsTags =~ m/$re/
 }

sub up($@)                                                                      # Go up to a specified context
 {my ($node, @tags) = @_;                                                       # Start node, tags identifying context
  for(my $p = $node; $p; $p = $p->parent)                                       # Go up
   {return $p if $p->at(@tags);                                                 # Return node which satisfies the condition
   }
  undef                                                                         # Not found
 }

#1 Editing                                                                      # Edit the data in the parse tree
sub change($$@)                                                                 # Change the name of a node in an optional tag context
 {my ($node, $name, @tags) = @_;                                                # Node, new name, tags defining the context
  return undef if @tags and !$node->at(@tags);
  $node->tag = $name;                                                           # Change name
  if (my $parent = $node->parent) {$parent->indexNode}                          # Reindex parent
  $node
 }

sub deleteAttr($$;$)                                                            # Delete the attribute, optionally checking its value first
 {my ($node, $attr, $value) = @_;                                               # Node, attribute name, optional attribute value to check first
  my $a = $node->attributes;                                                    # Attributes hash
  if (@_ == 3)
   {delete $a->{$attr} if defined($a->{$attr}) and $a->{$attr} eq $value;       # Delete user key if it has the right value
   }
  else
   {delete $a->{$attr};                                                         # Delete user key unconditionally
   }
  $node
 }

sub renameAttr($$$)                                                             # Change the name of an attribute regardless of whether the new attribute already exists
 {my ($node, $old, $new) = @_;                                                  # Node, existing attribute name, new attribute name
  my $a = $node->attributes;                                                    # Attributes hash
  if (defined($a->{$old}))                                                      # Check old attribute exists
   {my $value = $a->{$old};                                                     # Existing value
    $a->{$new} = $value;                                                        # Change the attribute name
    delete $a->{$old};
   }
  $node
 }

sub changeAttr($$$)                                                             # Change the name of an attribute unless it is already there
 {my ($node, $old, $new) = @_;                                                  # Node, existing attribute name, new attribute name
  exists $node->attributes->{$new} ? undef : $node->renameAttr($old, $new)      # Check old attribute exists
 }

sub renameAttrValue($$$$$)                                                      # Change the name and value of an attribute regardless of whether the new attribute already exists
 {my ($node, $old, $oldValue, $new, $newValue) = @_;                            # Node, existing attribute name and value, new attribute name and value
  my $a = $node->attributes;                                                    # Attributes hash
  if (defined($a->{$old}) and $a->{$old} eq $oldValue)                          # Check old attribute exists and has the specified value
   {$a->{$new} = $newValue;                                                     # Change the attribute name
    delete $a->{$old};
   }
  $node
 }

sub changeAttrValue($$$$$)                                                      # Change the name and value of an attribute unless it is already there
 {my ($node, $old, $oldValue, $new, $newValue) = @_;                            # Node, existing attribute name and value, new attribute name and value
  exists $node->attributes->{$new} ? undef :                                    # Check old attribute exists
    $node->renameAttrValue($old, $oldValue, $new, $newValue)
 }

#2 Structure                                                                    # Change the structure of the parse tree
sub wrapWith($$)                                                                # Wrap the original node in a new node forcing the original node down deepening the parse tree
 {my ($old, $tag) = @_;                                                         # Node, tag for new node
  my $new = bless {tag=>$tag};                                                  # Create wrapping node
  if (my $par = $old->parent)                                                   # Parent node exists
   {my $c = $par->content;                                                      # Content array of parent
    my $i = $old->position;                                                     # Position in content array
    splice(@$c, $i, 1, $new);                                                   # Replace node
    $old->parent  =  $new;                                                      # Set parent of original node as wrapping node
    $new->parent  =  $par;                                                      # Set parent of wrapping node
    $new->content = [$old];                                                     # Create content for wrapping node
    $par->indexNode;                                                            # Rebuild indices for parent
    $new->indexNode;                                                            # Create index for wrapping node
   }
  else                                                                          # At  the top - no parent
   {$new->content = [$old];                                                     # Create content for wrapping node
    $old->parent  =  $new;                                                      # Set parent of original node as wrapping node
    $new->parent  = undef;                                                      # Set parent of wrapping node - there is none
    $new->indexNode;                                                            # Create index for wrapping node
   }
  $new                                                                          # Return wrapping node
 }

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
 {my ($old, $tag) = @_;                                                         # Node, tag for new node
  my $new = bless {tag=>$tag};                                                  # Create wrapping node
  $new->content = $old->content;                                                # Transfer content
  $old->content = [$new];                                                       # Insert new node
  $new->indexNode;                                                              # Create indices for new node
  $old->indexNode;                                                              # Rebuild indices for old mode
  $new                                                                          # Return new node
 }

sub unwrap($)                                                                   # Unwrap a node by inserting its content into its parent at the point containing the node
 {my ($node) = @_;                                                              # Node to unwrap
  my $parent = $node->parent;                                                   # Parent node
  $parent or confess "Cannot unwrap the outer most node";
  my $p = $parent->content;                                                     # Content array of parent
  my $n = $node->content;                                                       # Content array of node
  my $i = $node->position;                                                      # Position of node in parent
  splice(@$p, $i, 1, @$n);                                                      # Replace node with its content
  $parent->indexNode;                                                           # Rebuild indices for parent
  $node->parent = undef;                                                        # Remove node from parse tree
  [$parent, $node]                                                              # Return node - which will still refer to its content and be a parse tree in its own right
 }

sub replaceWith($$)                                                             # Replace a node (and all its content) with a new node (and all its content)
 {my ($old, $new) = @_;                                                         # Old node, new node
  if (my $parent = $old->parent)                                                # Parent node of old node
   {my $c = $parent->content;                                                   # Content array of parent
    if (defined(my $i = $old->position))                                        # Position of old node in content array of parent
     {splice(@$c, $i, 1, $new);                                                 # Replace old node with new node
      $parent->indexNode;                                                       # Rebuild indices for parent
     }
   }
  $old->parent = undef;                                                         # Cut out node
  [$old, $new]                                                                  # Return [old node - which will still refer to its content and be a parse tree in its own right, new node]
 }

#2 Cut and Put                                                                  # Move nodes around in the parse tree
sub cut($)                                                                      # Cut out a node - remove the node from the parse tree and return it so that it can be put else where
 {my ($node) = @_;                                                              # Node to  cut out
  my $parent = $node->parent;                                                   # Parent node
  return $node unless $parent;                                                  # Uppermost node is already cut out
  my $c = $parent->content;                                                     # Content array of parent
  my $i = $node->position;                                                      # Position in content array
  splice(@$c, $i, 1);                                                           # Remove node
  $parent->indexNode;                                                           # Rebuild indices
  $node->parent = undef;                                                        # No parent after being cut out
  $node                                                                         # Return node
 }

sub putNext($$)                                                                 # Place the new node just after the original node in the content of the parent
 {my ($old, $new) = @_;                                                         # Original node, new node
  my $parent = $old->parent;                                                    # Parent node
  $parent or confess "Cannot place a node after the outermost node";            # The originating node must have a parent
  $new->parent and confess "Please cut out the node before moving it";          # The node must have be cut out first
  my $c = $parent->content;                                                     # Content array of parent
  my $i = $old->position;                                                       # Position in content array
  splice(@$c, $i+1, 0, $new);                                                   # Insert new node after original node
  $new->parent = $parent;                                                       # Return node
  $parent->indexNode;                                                           # Rebuild indices for parent
  $new                                                                          # Return the new node
 }

sub putPrev($$)                                                                 # Place the new node just before the original node in the content of the parent
 {my ($old, $new) = @_;                                                         # Original node, new node
  my $parent = $old->parent;                                                    # Parent node
  $parent or confess "Cannot place a node after the outermost node";            # The originating node must have a parent
  $new->parent and confess "Please cut out the node before moving it";          # The node must have be cut out first
  my $c = $parent->content;                                                     # Content array of parent
  my $i = $old->position;                                                       # Position in content array
  splice(@$c, $i, 0, $new);                                                     # Insert new node before original node
  $new->parent = $parent;                                                       # Return node
  $parent->indexNode;                                                           # Rebuild indices for parent
  $new                                                                          # Return the new node
 }

sub putFirst($$)                                                                # Place the new node at the front of the content of the original node
 {my ($old, $new) = @_;                                                         # Original node, new node
  $new->parent and confess "Please cut out the node before moving it";          # The node must have be cut out first
  unshift @{$old->content}, $new;                                               # Content array of original node
  $old->indexNode;                                                              # Rebuild indices for node
  $new                                                                          # Return the new node
 }

sub putLast($$)                                                                 # Place the new node at the end of the content of the original node
 {my ($old, $new) = @_;                                                         # Original node, new node
  $new->parent and confess "Please cut out the node before moving it";          # The node must have be cut out first
  push @{$old->content}, $new;                                                  # Content array of original node
  $old->indexNode;                                                              # Rebuild indices for node
  $new                                                                          # Return the new node
 }

# Examples

# Test
sub test{eval join('', <Data::Edit::Xml::DATA>) or die $@}

test unless caller;

# Documentation
#extractDocumentation() unless caller;

1;

=encoding utf-8

=head1 Name

 Data::Edit::Xml - Edit data held in Xml format

=head1 Synopsis

 use Data::Edit::Xml;

 say STDERR Data::Edit::Xml::new(inputString=><<END)->                          # Docbook
<sli>
  <li>
    <p>Diagnose the problem</p>
    <p>This can be quite difficult</p>
    <p>Sometimes impossible</p>
  </li>
  <li>
  <p><pre>ls -la</pre></p>
  <p><pre>
drwxr-xr-x  2 phil phil   4096 Jun 15  2016 Desktop
drwxr-xr-x  2 phil phil   4096 Nov  9 20:26 Downloads
</pre></p>
  </li>
</sli>
END

 by(sub                                                                         # Transform Docbook to Dita
  {my ($o, $p) = @_;
   if ($o->at(qw(pre p li sli)) and $o->isOnlyChild)
    {$o->change($p->isFirst ? qw(cmd) : qw(stepresult));
     $p->unwrap;
    }
   elsif ($o->at(qw(li sli)) and $o->over(qr(\Ap( p)+\Z)))
    {$_->change($_->isFirst ? qw(cmd) : qw(info)) for $o->contents;
    }
  })->by(sub
  {my ($o) = @_;
   $o->change(qw(step))          if $o->at(qw(li sli));
   $o->change(qw(steps))         if $o->at(qw(sli));
   $o->id = 's'.($o->position+1) if $o->at(qw(step));
   $o->id = 'i'.($o->index+1)    if $o->at(qw(info));
   $o->wrapWith(qw(screen))      if $o->at(qw(CDATA stepresult));
  })->string =~ s/></>\n</gr;

 # Dita (after being formatted for easier reading):
 #
 # <steps>
 #   <step id="s1">
 #     <cmd>Diagnose the problem</cmd>
 #     <info id="i1">This can be quite difficult</info>
 #     <info id="i2">Sometimes impossible</info>
 #     </step>
 #   <step id="s2">
 #     <cmd>ls -la</cmd>
 #     <stepresult>
 #       <screen>
 # drwxr-xr-x  2 phil phil   4096 Jun 15  2016 Desktop
 # drwxr-xr-x  2 phil phil   4096 Nov  9 20:26 Downloads
 #       </screen>
 #     </stepresult>
 #   </step>
 # </steps>

=head1 Description


=head2 Constructor

=head3 new()

 New parse - call this method statically as in Data::Edit::Xml::new() with keyword parameters=> chosen from:

  inputString a string of xml to be parsed
  inputFile   a file of xml to be parsed
  name        a symbolic name for this parse used in messages about this parse and to name output files generated by this parse
  output      a directory into which to write output files
  errors      a sub directory of 'output' into which to write a copy of the string to be parsed in the event that an xml parse error is encountered while parsing this string


=head3 cdata()

 The name of the command name to use to represent text


=head2 Stringification

Print the parse tree

=head3 string($node)

 Build a string from a node of a parse tree and the nodes below it

     Parameter  Description
  1  $node      Start node

=head3 stringWithCondition($node, @conditions)

 Build a string from a node of a parse tree and the nodes below it subject to conditions to reject some nodes

     Parameter    Description
  1  $node        Start node
  2  @conditions  conditions in effect

=head3 addConditions($node, @conditions)

 Add conditions to a node

     Parameter    Description
  1  $node        Node
  2  @conditions  conditions to add

=head3 deleteConditions($node, @conditions)

 Delete conditions applied to a node

     Parameter    Description
  1  $node        Node
  2  @conditions  conditions to add

=head3 listConditions($node)

 List conditions applied to a node

     Parameter  Description
  1  $node      Node

=head3 isText($node)

 Is this a text node?

     Parameter  Description
  1  $node      Node to test

=head2 Attributes

Get or set attributes

=head3 attr :lvalue($node, $attribute)

 Value of attribute in current command

     Parameter   Description
  1  $node       Node in parse tree
  2  $attribute  attribute name

=head3 setAttr($node, %values)

 Set the value of an attribute in a command

     Parameter  Description
  1  $node      Node in parse tree
  2  %values    (attribute name=>new value)*

=head2 Contents

Contents of the current node

=head3 contents($node)

 Get all the nodes contained by this node as an array (not an array reference)

     Parameter  Description
  1  $node      Node

=head3 contentBeyond($node)

 Get all the nodes beyond this node at the level of this node

     Parameter  Description
  1  $node      Node

=head3 contentBefore($node)

 Get all the nodes before this node at the level of this node

     Parameter  Description
  1  $node      Node

=head3 contentAsTags($node)

 Get the tags of all the nodes contained by this node as a string

     Parameter  Description
  1  $node      Node

=head3 contentBeyondAsTags($node)

 Get the tags of all the nodes beyond this node as a string

     Parameter  Description
  1  $node      Node

=head3 contentBeforeAsTags($node)

 Get the tags of all the nodes before this node as a string

     Parameter  Description
  1  $node      Node

=head3 position($node)

 Find the position of a node in its parent's content

     Parameter  Description
  1  $node      Node

=head3 index($node)

 Find the position of a node in its parent's index

     Parameter  Description
  1  $node      Node

=head2 Navigation

Move around in the parse tree

=head3 context($node)

 Tags of this node and its ancestors joined to make a string

     Parameter  Description
  1  $node      Node

=head3 get($node, @position)

 Get a sub node under the current node by its position in each index with position zero assumed if no position is supplied

     Parameter  Description
  1  $node      Node
  2  @position  position specification: (index

=head3 c($node, $tag, $position)

 Get all the nodes with the tag of the specified name below the current node

     Parameter  Description
  1  $node      Node
  2  $tag       tag
  3  $position

=head3 first($node)

 Get the first node below this node

     Parameter  Description
  1  $node      Node

=head3 last($node)

 Get the last node below this node

     Parameter  Description
  1  $node      Node

=head3 isFirst($node)

 Is this node first under its parent?

     Parameter  Description
  1  $node      Node

=head3 isLast($node)

 Is this node last under its parent?

     Parameter  Description
  1  $node      Node

=head3 isOnlyChild($node)

 Is this the only child of its parent?

     Parameter  Description
  1  $node      Node

=head3 next($node)

 Get the node next to the current node

     Parameter  Description
  1  $node      Node

=head3 prev($node)

 Get the node previous to the current node

     Parameter  Description
  1  $node      Node

=head3 by($node, $sub, @context)

 Post-order traversal of a parse tree or sub tree - based on experience this is the most useful way to process xml documents

     Parameter  Description
  1  $node      Starting node
  2  $sub       sub to call for each sub node
  3  @context   accumulated context

=head3 at()

 Check the node is in the context specified by the array of tags from the ancestors going up the parse tree from the node


=head3 over($node, $re)

 Match the tags at the level below a node against a regular expression

     Parameter  Description
  1  $node      Node
  2  $re        regular expression

=head3 after($node, $re)

 Match the tags in the current level after a node against a regular expression

     Parameter  Description
  1  $node      Node
  2  $re        regular expression

=head3 before($node, $re)

 Match the tags in the current level before a node against a regular expression

     Parameter  Description
  1  $node      Node
  2  $re        regular expression

=head3 up($node, @tags)

 Go up to a specified context

     Parameter  Description
  1  $node      Start node
  2  @tags      tags identifying context

=head2 Editing

Edit the data in the parse tree

=head3 change($node, $name, @tags)

 Change the name of a node in an optional tag context

     Parameter  Description
  1  $node      Node
  2  $name      new name
  3  @tags      tags defining the context

=head3 deleteAttr($node, $attr, $value)

 Delete the attribute, optionally checking its value first

     Parameter  Description
  1  $node      Node
  2  $attr      attribute name
  3  $value     optional attribute value to check first

=head3 renameAttr($node, $old, $new)

 Change the name of an attribute regardless of whether the new attribute already exists

     Parameter  Description
  1  $node      Node
  2  $old       existing attribute name
  3  $new       new attribute name

=head3 changeAttr($node, $old, $new)

 Change the name of an attribute unless it is already there

     Parameter  Description
  1  $node      Node
  2  $old       existing attribute name
  3  $new       new attribute name

=head3 renameAttrValue($node, $old, $oldValue, $new, $newValue)

 Change the name and value of an attribute regardless of whether the new attribute already exists

     Parameter  Description
  1  $node      Node
  2  $old       existing attribute name and value
  3  $oldValue  new attribute name and value
  4  $new
  5  $newValue

=head3 changeAttrValue($node, $old, $oldValue, $new, $newValue)

 Change the name and value of an attribute unless it is already there

     Parameter  Description
  1  $node      Node
  2  $old       existing attribute name and value
  3  $oldValue  new attribute name and value
  4  $new
  5  $newValue

=head3 Structure

Change the structure of the parse tree

=head4 wrapWith($old, $tag)

 Wrap the original node in a new node forcing the original node down deepening the parse tree

     Parameter  Description
  1  $old       Node
  2  $tag       tag for new node

=head4 wrapContentWith($old, $tag)

 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

     Parameter  Description
  1  $old       Node
  2  $tag       tag for new node

=head4 unwrap($node)

 Unwrap a node by inserting its content into its parent at the point containing the node

     Parameter  Description
  1  $node      Node to unwrap

=head4 replaceWith($old, $new)

 Replace a node (and all its content) with a new node (and all its content)

     Parameter  Description
  1  $old       Old node
  2  $new       new node

=head3 Cut and Put

Move nodes around in the parse tree

=head4 cut($node)

 Cut out a node - remove the node from the parse tree and return it so that it can be put else where

     Parameter  Description
  1  $node      Node to  cut out

=head4 putNext($old, $new)

 Place the new node just after the original node in the content of the parent

     Parameter  Description
  1  $old       Original node
  2  $new       new node

=head4 putPrev($old, $new)

 Place the new node just before the original node in the content of the parent

     Parameter  Description
  1  $old       Original node
  2  $new       new node

=head4 putFirst($old, $new)

 Place the new node at the front of the content of the original node

     Parameter  Description
  1  $old       Original node
  2  $new       new node

=head4 putLast($old, $new)

 Place the new node at the end of the content of the original node

     Parameter  Description
  1  $old       Original node
  2  $new       new node


=head1 Index of methods by name

L</addConditions($node, @conditions)>
L</after($node, $re)>
L</at()>
L</attr :lvalue($node, $attribute)>
L</before($node, $re)>
L</by($node, $sub, @context)>
L</c($node, $tag, $position)>
L</cdata()>
L</change($node, $name, @tags)>
L</changeAttr($node, $old, $new)>
L</changeAttrValue($node, $old, $oldValue, $new, $newValue)>
L</contentAsTags($node)>
L</contentBefore($node)>
L</contentBeforeAsTags($node)>
L</contentBeyond($node)>
L</contentBeyondAsTags($node)>
L</contents($node)>
L</context($node)>
L</cut($node)>
L</deleteAttr($node, $attr, $value)>
L</deleteConditions($node, @conditions)>
L</first($node)>
L</get($node, @position)>
L</index($node)>
L</isFirst($node)>
L</isLast($node)>
L</isOnlyChild($node)>
L</isText($node)>
L</last($node)>
L</listConditions($node)>
L</new()>
L</next($node)>
L</over($node, $re)>
L</position($node)>
L</prev($node)>
L</putFirst($old, $new)>
L</putLast($old, $new)>
L</putNext($old, $new)>
L</putPrev($old, $new)>
L</renameAttr($node, $old, $new)>
L</renameAttrValue($node, $old, $oldValue, $new, $newValue)>
L</replaceWith($old, $new)>
L</setAttr($node, %values)>
L</string($node)>
L</stringWithCondition($node, @conditions)>
L</unwrap($node)>
L</up($node, @tags)>
L</wrapContentWith($old, $tag)>
L</wrapWith($old, $tag)>

=head1 Installation

This module is written in 100% Pure Perl and is thus easy to read, modify and
install.

Standard Module::Build process for building and installing modules:

  perl Build.PL
  ./Build
  ./Build test
  ./Build install

=head1 Author

philiprbrenan@gmail.com

http://www.appaapps.com

=head1 Copyright

Copyright (c) 2016 Philip R Brenan.

This module is free software. It may be used, redistributed and/or modified
under the same terms as Perl itself.

=cut

__DATA__
use warnings FATAL=>qw(all);
use strict;
use Test::More tests=>56;
use Data::Table::Text qw(:all);

sub sample1{Data::Edit::Xml::new(inputString=><<END)}                           # Sample test xml
<foo start="yes">
  <head id="a" key="aaa bbb" start="123">Hello
    <em>there</em>
  </head>
  <bar>Howdy
    <ref/>
  </bar>do
doo
  <head id="A" key="AAAA BBBB" start="123">HHHHello
    <b>to you</b>
  </head>
  <tail>
    <foot id="11"/>
    <middle id="mm"/>
    <foot id="22"/>
  </tail>
</foo>
END

sub sample2{Data::Edit::Xml::new(inputString=>'<a id="aa"><b id="bb"><c id="cc"/></b></a>')}

if (1)                                                                          # Parse and string
 {my $x = sample1;
  if (my $s = $x->string)
   {ok $s eq trim(<<END);
<foo start="yes"><head id="a" key="aaa bbb" start="123">Hello
    <em>there</em></head><bar>Howdy
    <ref/></bar>do
doo
  <head id="A" key="AAAA BBBB" start="123">HHHHello
    <b>to you</b></head><tail><foot id="11"/><middle id="mm"/><foot id="22"/></tail></foo>
END
   }
  if (1)                                                                        # Conditions
   {my $m = $x->get(qw(tail middle));
    $m->addConditions(qw(middle MIDDLE));                                       # Add
    ok join(' ', $m->listConditions) eq 'MIDDLE middle';                        # List
    $m->deleteConditions(qw(MIDDLE));                                           # Remove
    ok join('', $m->listConditions) eq 'middle';
    $_->addConditions(qw(foot)) for $x->get(qw(tail foot *));

    ok $x->stringWithCondition(qw(middle)) eq trim(<<END);
<foo start="yes"><head id="a" key="aaa bbb" start="123">Hello
    <em>there</em></head><bar>Howdy
    <ref/></bar>do
doo
  <head id="A" key="AAAA BBBB" start="123">HHHHello
    <b>to you</b></head><tail><middle id="mm"/></tail></foo>
END

    ok $x->stringWithCondition(qw(foot))  eq trim(<<END);
<foo start="yes"><head id="a" key="aaa bbb" start="123">Hello
    <em>there</em></head><bar>Howdy
    <ref/></bar>do
doo
  <head id="A" key="AAAA BBBB" start="123">HHHHello
    <b>to you</b></head><tail><foot id="11"/><foot id="22"/></tail></foo>
END

    ok $x->stringWithCondition(qw(none)) eq trim(<<END);
<foo start="yes"><head id="a" key="aaa bbb" start="123">Hello
    <em>there</em></head><bar>Howdy
    <ref/></bar>do
doo
  <head id="A" key="AAAA BBBB" start="123">HHHHello
    <b>to you</b></head><tail/></foo>
END

    ok $x->stringWithCondition(qw(foot middle)) eq $x->string;
    ok $x->stringWithCondition eq $x->string;
   }

  if (my $h = $x->get(qw(head))) {ok $h->id eq qw(a)} else {ok 0}               # Attributes and sub nodes

 # Contents
  ok formatTable([map {$_->tag} $x->contents], '')                        eq '0  head   1  bar    2  CDATA  3  head   4  tail   ';
  ok formatTable([map {$_->tag} $x->get(qw(head))   ->contentBeyond], '') eq '0  bar    1  CDATA  2  head   3  tail   ';
  ok formatTable([map {$_->tag} $x->get(qw(head), 1)->contentBefore], '') eq '0  head   1  bar    2  CDATA  ';

  ok $x->contentAsTags  eq join ' ', qw(head bar CDATA head tail);
  ok $x->get(qw(head),0)->contentBeyondAsTags eq join ' ', qw(     bar CDATA head tail);
  ok $x->get(qw(head),1)->contentBeforeAsTags eq join ' ', qw(head bar CDATA);

  ok $x->over(qr(\Ahead bar CDATA head tail\Z));
  ok $x->get(qw(head),0)->after (qr(\Abar CDATA head tail\Z));
  ok $x->get(qw(head),1)->before(qr(\Ahead bar CDATA\Z));

  ok @{$x->c(qw(head))}  == 2;
  ok $x->get(qw(head *)) == 2;
  ok $x->get(qw(head),1)->position == 3;

  ok $x->get(qw(tail))->first->id == 11;
  ok $x->get(qw(tail))->last ->id == 22;
  ok $x->get(qw(tail))->first->isFirst;
  ok $x->get(qw(tail))->last ->isLast;

  ok sample2->first->isOnlyChild;
  ok sample2->first->first->isOnlyChild;
  ok !$x->get(qw(tail))->last->isOnlyChild;

  ok $x->get(qw(tail))->first->next->id eq 'mm';
  ok $x->get(qw(tail))->last->prev->prev->isFirst;
  ok $x->get(qw(head))->get(qw(em))->first->at(qw(CDATA em head foo));  # At

  if (1)                                                                        # Through
   {my @t;
    $x->first->by(sub {my ($o) = @_; push @t, $o->tag});
    ok formatTable([@t], '') eq '0  CDATA  1  CDATA  2  em     3  head   ';
   }

  if (1)
   {my @t;
    $x->last->by(sub {my ($o) = @_; push @t, $o->tag});
    ok formatTable([@t], '') eq '0  foot    1  middle  2  foot    3  tail    ';
   }

# Editting - outermost - wrapWith

  ok sample1->wrapWith("out")->string eq trim(<<END);
<out><foo start="yes"><head id="a" key="aaa bbb" start="123">Hello
    <em>there</em></head><bar>Howdy
    <ref/></bar>do
doo
  <head id="A" key="AAAA BBBB" start="123">HHHHello
    <b>to you</b></head><tail><foot id="11"/><middle id="mm"/><foot id="22"/></tail></foo></out>
END

  ok sample1->wrapContentWith("out")->parent->string eq trim(<<END);
<foo start="yes"><out><head id="a" key="aaa bbb" start="123">Hello
    <em>there</em></head><bar>Howdy
    <ref/></bar>do
doo
  <head id="A" key="AAAA BBBB" start="123">HHHHello
    <b>to you</b></head><tail><foot id="11"/><middle id="mm"/><foot id="22"/></tail></out></foo>
END

# Editting - inner - wrapWith
  ok sample1->get(qw(tail))->get(qw(middle))->wrapWith("MIDDLE")->parent->parent->string eq trim(<<END);
<foo start="yes"><head id="a" key="aaa bbb" start="123">Hello
    <em>there</em></head><bar>Howdy
    <ref/></bar>do
doo
  <head id="A" key="AAAA BBBB" start="123">HHHHello
    <b>to you</b></head><tail><foot id="11"/><MIDDLE><middle id="mm"/></MIDDLE><foot id="22"/></tail></foo>
END

 ok sample1->get(qw(tail))->get(qw(middle))->wrapContentWith("MIDDLE")->parent->parent->parent->string eq trim(<<END);
<foo start="yes"><head id="a" key="aaa bbb" start="123">Hello
    <em>there</em></head><bar>Howdy
    <ref/></bar>do
doo
  <head id="A" key="AAAA BBBB" start="123">HHHHello
    <b>to you</b></head><tail><foot id="11"/><middle id="mm"><MIDDLE/></middle><foot id="22"/></tail></foo>
END

# Editting - cut/put

  if (1)
   {my $a = sample2;
    ok $a->get(qw(b))->id eq qw(bb);
    ok $a->get(qw(b c))->id  eq qw(cc);
    $a->putFirst($a->get(qw(b c))->cut);                                        # First
    ok $a->string eq '<a id="aa"><c id="cc"/><b id="bb"/></a>';
    $a->putLast($a->get(qw(c))->cut);                                           # Last
    ok $a->string eq '<a id="aa"><b id="bb"/><c id="cc"/></a>';
    $a->get(qw(c))->putNext($a->get(qw(b))->cut);                               # Next
    ok $a->string eq '<a id="aa"><c id="cc"/><b id="bb"/></a>';
    $a->get(qw(c))->putPrev($a->get(qw(b))->cut);                               # Prev
    ok $a->string eq '<a id="aa"><b id="bb"/><c id="cc"/></a>';
   }

# Editting - unwrap

  ok sample2->get(qw(b))->unwrap->[0]->string eq '<a id="aa"><c id="cc"/></a>';
  ok sample2->get(qw(b c))->putFirst(sample2)->parent->parent->parent->string eq '<a id="aa"><b id="bb"><c id="cc"><a id="aa"><b id="bb"><c id="cc"/></b></a></c></b></a>';
  ok sample2->get(qw(b c))->replaceWith(sample2)->[1]->get(qw(b c))->up(qw(a b))->string eq '<a id="aa"><b id="bb"><c id="cc"/></b></a>';

# Editting - tag /attributes

  ok  sample2->get(qw(b))->change(qw(B b a))->parent->string eq '<a id="aa"><B id="bb"><c id="cc"/></B></a>';
  ok !sample2->get(qw(b))->change(qw(B c a));
  ok  sample2->get(qw(b))->setAttr(aa=>11, bb=>22)->parent->string eq '<a id="aa"><b aa="11" bb="22" id="bb"><c id="cc"/></b></a>';
  ok  sample2->get(qw(b c))->setAttr(aa=>11, bb=>22)->parent->parent->string eq '<a id="aa"><b id="bb"><c aa="11" bb="22" id="cc"/></b></a>';
  ok  sample2->deleteAttr(qw(id))->string eq '<a><b id="bb"><c id="cc"/></b></a>';
  ok  sample2->renameAttr(qw(id ID))->string eq '<a ID="aa"><b id="bb"><c id="cc"/></b></a>';
  ok !sample2->changeAttr(qw(ID id));

  ok  sample2->renameAttrValue(qw(id aa ID AA))->string eq '<a ID="AA"><b id="bb"><c id="cc"/></b></a>';
  ok !sample2->changeAttrValue(qw(ID AA id aa));
 }

ok Data::Edit::Xml::new(inputString=><<END)->                                   # Docbook
<sli>
  <li>
    <p>Diagnose the problem</p>
    <p>This can be quite difficult</p>
    <p>Sometimes impossible</p>
  </li>
  <li>
  <p><pre>ls -la</pre></p>
  <p><pre>
drwxr-xr-x  2 phil phil   4096 Jun 15  2016 Desktop
drwxr-xr-x  2 phil phil   4096 Nov  9 20:26 Downloads
</pre></p>
  </li>
</sli>
END

by(sub                                                                          # Transform Docbook to Dita
 {my ($o, $p) = @_;
  if ($o->at(qw(pre p li sli)) and $o->isOnlyChild)
   {$o->change($p->isFirst ? qw(cmd) : qw(stepresult));
    $p->unwrap;
   }
  elsif ($o->at(qw(li sli)) and $o->over(qr(\Ap( p)+\Z)))
   {$_->change($_->isFirst ? qw(cmd) : qw(info)) for $o->contents;
   }
 })->by(sub
 {my ($o) = @_;
  $o->change(qw(step))          if $o->at(qw(li sli));
  $o->change(qw(steps))         if $o->at(qw(sli));
  $o->id = 's'.($o->position+1) if $o->at(qw(step));
  $o->id = 'i'.($o->index+1)    if $o->at(qw(info));
  $o->wrapWith(qw(screen))      if $o->at(qw(CDATA stepresult));
 })->string =~ s/></>\n</gr eq trim(<<END);                                     # Dita
<steps>
<step id="s1">
<cmd>Diagnose the problem</cmd>
<info id="i1">This can be quite difficult</info>
<info id="i2">Sometimes impossible</info>
</step>
<step id="s2">
<cmd>ls -la</cmd>
<stepresult>
<screen>
drwxr-xr-x  2 phil phil   4096 Jun 15  2016 Desktop
drwxr-xr-x  2 phil phil   4096 Nov  9 20:26 Downloads
</screen>
</stepresult>
</step>
</steps>
END
