Data-Edit-Xml
view release on metacpan or search on metacpan
lib/Data/Edit/Xml.pm view on Meta::CPAN
? "\n$space": "") : $space;
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
lib/Data/Edit/Xml.pm view on Meta::CPAN
{my %m = map {$_=>1} @match;
return grep {$m{$_->tag}} @c;
}
@c # Elements in the specified range
}
#D1 Location # Locate the line numbers and columns of a specified node and write that information as a L<Oxygen Message|/https://www.oxygenxml.com/doc/versions/20.1/ug-author/topics/l...
sub parseLineLocation($) #PS Parse a line location
{my ($loc) = @_; # Location
my ($l, $c, $L, $C) = split m/[.:]/, $loc; # Position of node in source
for my $n($l, $c, $L) # Check that some-one else is not using xtrf for some other reason
{return () unless $n and $n =~ m(\A\d+\Z)s;
}
return () if $L and $L !~ m(\A\d+\Z)s;
unless(defined $C) # Same line
{$C = $L;
$L = 0;
}
lib/Data/Edit/Xml.pm view on Meta::CPAN
{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
my @lines = split m/\n/, $valid; # Split into lines
for my $i(keys @lines) # Each line
{my $line = $lines[$i] =~ s(\s*#.*\Z) ()r; # Remove trailing comments
next unless $line =~ m(\S); # Ignore blank lines
my sub error(@) # Write an error message
{confess join ' ', @_, 'on line:', $i + 1, "\n";
};
my $tag = $line =~ s(\A\s*) ()r; # Check indentation carefully as it shows the desired structure
lib/Data/Edit/Xml.pm view on Meta::CPAN
@stack+1 < $indent2 and error "Too much indentation";
while(@stack) # Reduce the stack to the current level
{if (@stack > $indent2)
{pop @stack;
next;
}
last;
}
my ($tagName, @words) = split m/\s+/, $tag; # Save tag on the tag stack
push @stack, $tagName;
my $count = sub # The count indicator optionally follows the tag
{return 1 unless @words; # The default is just one and it is required
my $c = shift @words;
return $c if $c =~ m(\A[-1+*?]\Z)i; # Valid operators
1
}->();
if (@stack > 1) # Element description
{$valid{join ' ', @stack[1..$#stack]} =
[$count, my $comment = join ' ', @words];
}
}
my ($root) = @stack; # The root tag
for my $a(sort keys %valid) # Create get methods
{for my $b(sort keys %valid)
{my $c = $valid{$b}[0]; # Count field
my @b = split m/\s+/, $b;
my $m = pop @b;
if ($a eq join " ", @b or !@b) # Has children
{my @m = ($root, @b);
if (!isSubInPackage((join '::', @m), $m))
{my $d = $c eq q(*) || $c eq q(+) ? q([]) : q/q()/; # Default return value
my $s = join ' ', qq(sub), (join '::', @m, $m), qq({\$_[0]{$m} // $d});
eval $s;
if ($@)
{confess join '', "Unable to create method: ",$a, q(::).qq($m\n$@\n);
lib/Data/Edit/Xml.pm view on Meta::CPAN
}
else
{my $j = -p $o;
confess "Junk: $j\n";
}
});
for my $v(sort keys %$validator) # Validate presence of required elements by checking the application of each rule which requires at least one sub element
{my ($count) = $$validator{$v}->@*; # Count specification from this validation specification
next unless $count =~ m(\A[1+]\Z)i; # We are only interested in required elements
my @path = split m/\s+/, $v; # Path to this rule
my $parent = join ' ', reverse $xmlTree->tag, @path[0..@path-2]; # Path to parent of this rule
$xmlTree->by(sub # Traverse xml to build Perl data structure
{my ($o) = @_;
if ($parent eq $o->context) # Point in the xml parse tree that matches the parent rule
{my $child = $path[-1];
my @c = $o->c($child);
if (@c < 1)
{say STDERR -p $o;
confess join " ", "$child required under", $o->context, "\n";
( run in 2.797 seconds using v1.01-cache-2.11-cpan-71847e10f99 )