ok, I can't leave this alone :)
To get
/p1:root
/p1:root/p1:foo[1]
/p1:root/p1:foo[2]
/p1:root/p1:bar[1]
/p1:root/p1:bar[2]
Prefix definitions:
p1: http://www.example.org/tooty
instead of
/*
/*/*[1]
/*/*[2]
/*/*[3]
/*/*[4]
requires a lot more work.
use strict;
use warnings;
use XML::LibXML qw( XML_ELEMENT_NODE );
sub _qname {
my ($cx, $node) = @_;
my $name = $node->nodeName();
my $uri = $node->namespaceURI();
return $name if !defined($uri);
my $prefix = $cx->[1]{$uri};
if (!defined($prefix)) {
$cx->[1]{$uri} = $prefix = 'p' . ++($cx->[0]);
$cx->[2]->registerNs($prefix, $uri);
}
return "$prefix:$name";
}
sub _visit {
my ($cx, $path, $node) = @_;
print("$path\n");
$path .= '/' if length($path) && $path !~ m{/\z};
my @children =
grep $_->nodeType() == XML_ELEMENT_NODE,
$node->childNodes();
my %idxs;
for (0..$#children) {
my $node = $children[$_];
my $qname = _qname($cx, $node);
my $i = ++$idxs{$qname};
_visit($cx, "$path$qname\[$i]", $node);
}
}
sub visit_node {
my ($node) = @_;
my $cx = [ 0, {}, XML::LibXML::XPathContext->new() ];
my $path = '.';
_visit($cx, $path, $node);
print("\n");
print("Prefix definitions:\n");
for my $uri (keys(%{ $cx->[1] })) {
my $prefix = $cx->[1]{$uri};
print("$prefix: $uri\n");
}
}
sub visit_doc {
my ($doc) = @_;
my $node = $doc->documentElement();
my $cx = [ 0, {}, XML::LibXML::XPathContext->new() ];
my $path = '/' . _qname($cx, $node);
_visit($cx, $path, $node);
print("\n");
print("Prefix definitions:\n");
for my $uri (keys(%{ $cx->[1] })) {
my $prefix = $cx->[1]{$uri};
print("$prefix: $uri\n");
}
}
my $parser = XML::LibXML->new();
my $doc = $parser->parse_fh(*STDIN);
visit_doc($doc);
The code doesn't use the XML::LibXML::XPathContext object it creates, but I figured you'd need it if you're building xpaths.
| 