Blob Blame History Raw
Author: Ardo van Rangelrooij <ardo@debian.org>
Description:
  * examples/xpath: patched by Fabien Ninoles <fabien@Nightbird.TZoNE.ORG>
    (thanks Fabien!)
  * examples/xpath: fixed erroneous handling of filenames containing a '-'
    (closes: Bug#185292)
  * examples/xpath: fixed various small typos in the POD
    (closes: Bug#180508)

diff -up XML-XPath-1.13/examples/xpath.old XML-XPath-1.13/examples/xpath
--- XML-XPath-1.13/examples/xpath.old	2001-02-14 13:43:33.000000000 +0100
+++ XML-XPath-1.13/examples/xpath	2012-03-16 17:31:58.812485837 +0100
@@ -1,74 +1,113 @@
 #!/usr/bin/perl -w
+
+eval 'exec /usr/bin/perl -w -S $0 ${1+"$@"}'
+    if 0; # not running under some shell
 use strict;
 
 $| = 1;
 
-unless (@ARGV >= 1) {
-	print STDERR qq(Usage:
-$0 [filename] query
-				
-	If no filename is given, supply XML on STDIN.
-);
-	exit;
-}
-
 use XML::XPath;
 
-my $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.
+);
 
-if ($ARGV[0] eq '-p') {
-	# pipeline mode
-	$pipeline = 1;
-	shift @ARGV;
-}
-if (@ARGV >= 2) {
-	$xpath = XML::XPath->new(filename => shift(@ARGV));
-}
-else {
-	$xpath = XML::XPath->new(ioref => \*STDIN);
-}
-
-my $nodes = $xpath->find(shift @ARGV);
-
-unless ($nodes->isa('XML::XPath::NodeSet')) {
-NOTNODES:
-	print STDERR "Query didn't return a nodeset. Value: ";
-	print $nodes->value, "\n";
 	exit;
 }
 
-if ($pipeline) {
-	$nodes = find_more($nodes);
-	goto NOTNODES unless $nodes->isa('XML::XPath::NodeSet');
-}
-
-if ($nodes->size) {
-	print STDERR "Found ", $nodes->size, " nodes:\n";
-	foreach my $node ($nodes->get_nodelist) {
-		print STDERR "-- NODE --\n";
-		print $node->toString;
-	}
-}
-else {
-	print STDERR "No nodes found";
-}
-
-print STDERR "\n";
+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) = @_;
-	if (!@ARGV) {
-		return $nodes;
-	}
 	
 	my $newnodes = XML::XPath::NodeSet->new;
 	
-	my $find = shift @ARGV;
-	
 	foreach my $node ($nodes->get_nodelist) {
 		my $new = $xpath->find($find, $node);
 		if ($new->isa('XML::XPath::NodeSet')) {
@@ -79,5 +118,80 @@ sub find_more {
 		}
 	}
 	
-	return find_more($newnodes);
+	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