libxml-xpath-perl 1.13-7 / usr / bin / xpath

#!/usr/bin/perl -w

eval 'exec /usr/bin/perl -w -S $0 ${1+"$@"}'
    if 0; # not running under some shell

eval 'exec /usr/bin/perl -w -S $0 ${1+"$@"}'
    if 0; # not running under some shell
use strict;

$| = 1;

use XML::XPath;

my @paths;
my $pipeline;
my $SUFFIX = "\n";
my $PREFIX = "";
my $quiet = 0;


PARSE: while ((@ARGV >= 1) && ($ARGV[0] =~ /^-./ )) {
	OPTIONS: {
		if ($ARGV[0] eq "-e") {
			shift;
			push @paths, shift;
			last OPTIONS;
		}
		if ($ARGV[0] eq "-p") {
			shift;
			$PREFIX = shift;
			last OPTIONS;
		}
		if ($ARGV[0] eq "-s") {
			shift;
			$SUFFIX = shift;
			last OPTIONS;
		}
		if ($ARGV[0] eq "-q") {
			$quiet = 1;
			shift;
			last OPTIONS;
		}
		print STDERR "Unknown option ignore: ", shift;
	}
}

unless (@paths >= 1) {
	print STDERR qq(Usage:
$0 [options] -e query [-e query...] [filename...]

	If no filenams are given, supply XML on STDIN.
	You must provide at least one query. Each supplementary
	query is done in order, the previous query giving the
	context of the next one.

	Options:

	-q		quiet. Only output the resulting PATH
	-s suffix	use suffix instead of linefeed.
	-p postfix	use prefix instead of nothing.
);
	exit;
}

do
{
	my $xpath;
	my @curpaths = @paths;
	my $filename;
	if (@ARGV >= 1) {
		$filename = shift @ARGV;
		$xpath = XML::XPath->new(filename => $filename);
	}
	else {
		$filename = 'stdin';
		$xpath = XML::XPath->new(ioref => \*STDIN);
	}

	my $nodes = $xpath->find(shift @curpaths);

	if ($nodes->isa('XML::XPath::NodeSet')) {
		while (@curpaths >= 1) {
			$nodes = find_more($xpath, shift @curpaths, $nodes);
			last unless $nodes->isa('XML::XPath::NodeSet');
		}
	}

	if ($nodes->isa('XML::XPath::NodeSet')) {
		if ($nodes->size) {
			print STDERR "Found ", $nodes->size, " nodes in $filename:\n" unless $quiet;
			foreach my $node ($nodes->get_nodelist) {
				print STDERR "-- NODE --\n" unless $quiet;
				print $PREFIX, $node->toString, $SUFFIX;
			}
		}
		else {
			print STDERR "No nodes found in $filename\n" unless $quiet;
		}
	}
	else {
		print STDERR "Query didn't return a nodeset. Value: ";
		print $nodes->value, "\n";
	}

} until (@ARGV < 1);

exit;

sub find_more {
	my $xpath = shift;
	my $find = shift;
	my ($nodes) = @_;
	
	my $newnodes = XML::XPath::NodeSet->new;
	
	foreach my $node ($nodes->get_nodelist) {
		my $new = $xpath->find($find, $node);
		if ($new->isa('XML::XPath::NodeSet')) {
			$newnodes->append($new);
		}
		else {
			warn "Not a nodeset: ", $new->value, "\n";
		}
	}
	
	return $newnodes;
}

__END__

=head1 NAME

xpath - a script to query XPath statements in XML documents.

=head1 SYNOPSIS

B<xpath [-s suffix] [-p prefix] [-q] -e query [-e query] ... [file] ...>

=head1 DESCRIPTION

B<xpath> uses the L<XML::XPath|XML::XPath> perl module to make XPath queries
to any XML document. The L<XML::XPath|XML::XPath> module aims to comply exactly
to the XPath specification at C<http://www.w3.org/TR/xpath> and yet
allows extensions to be added in the form of functions.

The script takes any number of XPath pointers and tries to apply them
to each XML document given on the command line. If no file arguments
are given, the query is done using C<STDIN> as an XML document.

When multiple queries exist, the result of the last query is used as
context for the next query and only the result of the last one is output.
The context of the first query is always the root of the current document.

=head1 OPTIONS

=head2 B<-q>

Be quiet. Output only errors (and no separator) on stderr.

=head2 B<-s suffix>

Place C<suffix> at the end of each entry. Default is a linefeed.

=head2 B<-p prefix>

Place C<prefix> preceding each entry. Default is nothing.

=head1 BUGS

The author of this man page is not very fluant in english. Please,
send him (L<fabien@tzone.org>) any corrections concerning this text.

See also L<XML::XPath(3pm)>.

=head1 SEE ALSO

L<XML::XPath(3pm)>.

=head1 HISTORY

This module is copyright 2000 Fastnet Software Ltd. This is free
software, and as such comes with NO WARRANTY. No dates are used in this
module. You may distribute this module under the terms of either the
Gnu GPL,  or under specific licencing from Fastnet Software Ltd.
Special free licencing consideration will be given to similarly free
software. Please don't flame me for this licence - I've put a lot of
hours into this code, and if someone uses my software in their product
I expect them to have the courtesy to contact me first.

Full support for this module is available from Fastnet Software Ltd on
a pay per incident basis. Alternatively subscribe to the Perl-XML
mailing list by mailing lyris@activestate.com with the text:

	SUBSCRIBE Perl-XML

in the body of the message. There are lots of friendly people on the
list, including myself, and we'll be glad to get you started.

Matt Sergeant, matt@sergeant.org

This man page was added as well as some serious modifications to the script
by Fabien Ninoles <fabien@debian.org> for the Debian Project.

=cut