#!/usr/bin/env perl
#
# xpath - evaluate an XPath query on the input document(s)
#
# $Id$

use strict;
use warnings;

use Getopt::Std;
use XML::LibXML;
use XML::LibXML::XPathContext;

my %opt;
getopts( 'chHe:ld:', \%opt );

HELP_MESSAGE() if $opt{'h'};

my $xpr = $opt{e} // '.';
my $prefix_filename = $opt{l};

sub HELP_MESSAGE
{
  print STDERR <<ZZ;

Usage: $0 [-c] [-l] [-e xpathexpr] [xmlfile [xmlfile2 [..]]]

to evaluate an XPath expression on the input document(s),
writing the result to standard output.

Validation and network access are disabled.

All namespaces found at the root document node are registered,
so e.g. * will match all nodes in the default namespace.

Options:

  -e xpathexpr

    The XPath expression to evaluate.  If omitted,
    . is used (causing the input document to be returned).

  -d prefix

    The prefix to use for nodes in the default namespace (if any).
    Apparently, XPath offers no way to pretend it just isn't there.

  -l

    Prefix the output with the input filename, a colon, and a space.

  -H

    Use the HTML parser instead of the XML parser.

  -c

    Weed out blank nodes and redundant namespace declarations.

ZZ

  exit(0);
}

my $parser = new XML::LibXML(
  line_numbers     => 1,
  load_ext_dtd     => 0,         # disables validation, says the documentation
  no_blanks        => $opt{c},
  clean_namespaces => $opt{c},
  no_network       => 1,
  pedantic_parser  => 1
) or die "cannot create the XML parser\n";

#my $doc = $parser->parse_fh(*ARGV)  # produces a 'read error'
@ARGV or @ARGV = ('-');

foreach my $f (@ARGV)
{
  if ( my $doc =
    $opt{H} ? $parser->parse_html_file($f) : $parser->parse_file($f) )
  {
    xpath_eval( $doc, $f );
  }
  else
  {
    warn "no or invalid XML, skipped: $f\n";
  }
}

sub XML::LibXML::Namespace::toString
# quick hack, sorry
{
  sprintf( '%s=%s', $_[0]->declaredPrefix() // '', $_[0]->declaredURI() );
}

sub xpath_eval
{
  my ( $doc, $f ) = @_;
  my $root = $doc->documentElement;

  my $xpc = new XML::LibXML::XPathContext;

  foreach my $ns ( $xpc->findnodes( '/*/namespace::*', $root ) )
  {
    if ( my $prefix = $ns->declaredPrefix() // $opt{d} )
    {
      $xpc->registerNs( $prefix, $ns->declaredURI() );
    }
  }

  # find() doesn't return the same as findnodes() when it finds nodes
  # while findnodes() returns nothing when a value is returned
  my @r = $xpc->findnodes( $xpr, $root );

  if ( !@r )
  {
    @r = $xpc->find( $xpr, $root );
  }
  else
  {
    @r = map { $_->can('toString') ? $_->toString() : $_ } @r;
  }

  my $prefix = $prefix_filename ? "$f: " : '';

  foreach my $r (@r)
  {
    print $prefix, $r, $/;
  }
}