r22036 - in /trunk/libxml-xpath-perl: debian/ debian/patches/ examples/ t/
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Sat Jun 21 12:59:58 UTC 2008
Author: gregoa
Date: Sat Jun 21 12:59:57 2008
New Revision: 22036
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=22036
Log:
* Remove debian/libxml-xpath-perl.docs, install TODO via debian/rules.
* Refresh debian/rules, no functional changes.
* Split out remaining changes in upstream code into patches; activate quilt
in debian/rules.
Added:
trunk/libxml-xpath-perl/debian/patches/example.patch
trunk/libxml-xpath-perl/debian/patches/fix_comparison_bug_RT6363.patch
trunk/libxml-xpath-perl/debian/patches/test.patch
Removed:
trunk/libxml-xpath-perl/debian/libxml-xpath-perl.docs
trunk/libxml-xpath-perl/debian/patches/01-fix_comparison_bug_RT6363.patch
trunk/libxml-xpath-perl/t/base.t
Modified:
trunk/libxml-xpath-perl/debian/changelog
trunk/libxml-xpath-perl/debian/control
trunk/libxml-xpath-perl/debian/patches/series
trunk/libxml-xpath-perl/debian/rules
trunk/libxml-xpath-perl/examples/xpath
Modified: trunk/libxml-xpath-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libxml-xpath-perl/debian/changelog?rev=22036&op=diff
==============================================================================
--- trunk/libxml-xpath-perl/debian/changelog (original)
+++ trunk/libxml-xpath-perl/debian/changelog Sat Jun 21 12:59:57 2008
@@ -22,6 +22,10 @@
[ gregor herrmann ]
* Set debhelper compatibility level to 6.
* Remove changes in upstream Makefile.PL.
+ * Remove debian/libxml-xpath-perl.docs, install TODO via debian/rules.
+ * Refresh debian/rules, no functional changes.
+ * Split out remaining changes in upstream code into patches; activate quilt
+ in debian/rules.
-- gregor herrmann <gregor+debian at comodo.priv.at> Fri, 11 Jan 2008 01:51:59 +0100
Modified: trunk/libxml-xpath-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libxml-xpath-perl/debian/control?rev=22036&op=diff
==============================================================================
--- trunk/libxml-xpath-perl/debian/control (original)
+++ trunk/libxml-xpath-perl/debian/control Sat Jun 21 12:59:57 2008
@@ -8,7 +8,7 @@
Homepage: http://search.cpan.org/dist/XML-XPath/
Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libxml-xpath-perl/
Vcs-Browser: http://svn.debian.org/wsvn/pkg-perl/trunk/libxml-xpath-perl/
-Build-Depends: debhelper (>= 6), quilt
+Build-Depends: debhelper (>= 6), quilt (>= 0.40)
Build-Depends-Indep: perl, libxml-parser-perl
Package: libxml-xpath-perl
Added: trunk/libxml-xpath-perl/debian/patches/example.patch
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libxml-xpath-perl/debian/patches/example.patch?rev=22036&op=file
==============================================================================
--- trunk/libxml-xpath-perl/debian/patches/example.patch (added)
+++ trunk/libxml-xpath-perl/debian/patches/example.patch Sat Jun 21 12:59:57 2008
@@ -1,0 +1,258 @@
+Author: Ardo van Rangelrooij <ardo at debian.org>
+Description:
+ * examples/xpath: patched by Fabien Ninoles <fabien at 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)
+
+--- libxml-xpath-perl.orig/examples/xpath
++++ libxml-xpath-perl/examples/xpath
+@@ -1,74 +1,115 @@
+ #!/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;
+
+-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);
++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 ($nodes->isa('XML::XPath::NodeSet')) {
+-NOTNODES:
+- print STDERR "Query didn't return a nodeset. Value: ";
+- print $nodes->value, "\n";
++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;
+ }
+
+-if ($pipeline) {
+- $nodes = find_more($nodes);
+- goto NOTNODES unless $nodes->isa('XML::XPath::NodeSet');
+-}
++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);
++ }
+
+-if ($nodes->size) {
+- print STDERR "Found ", $nodes->size, " nodes:\n";
+- foreach my $node ($nodes->get_nodelist) {
+- print STDERR "-- NODE --\n";
+- print $node->toString;
++ 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" unless $quiet;
++ }
++ }
++ else {
++ print STDERR "Query didn't return a nodeset. Value: ";
++ print $nodes->value, "\n";
+ }
+-}
+-else {
+- print STDERR "No nodes found";
+-}
+
+-print STDERR "\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 +120,83 @@
+ }
+ }
+
+- 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 at 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 at 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 at sergeant.org
++
++This man page was added as well as some serious modifications to the script
++by Fabien Ninoles <fabien at debian.org> for the Debian Project.
++
++=cut
++
Added: trunk/libxml-xpath-perl/debian/patches/fix_comparison_bug_RT6363.patch
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libxml-xpath-perl/debian/patches/fix_comparison_bug_RT6363.patch?rev=22036&op=file
==============================================================================
--- trunk/libxml-xpath-perl/debian/patches/fix_comparison_bug_RT6363.patch (added)
+++ trunk/libxml-xpath-perl/debian/patches/fix_comparison_bug_RT6363.patch Sat Jun 21 12:59:57 2008
@@ -1,0 +1,97 @@
+Bug: #374672
+
+--- libxml-xpath-perl.orig/XPath/Expr.pm
++++ libxml-xpath-perl/XPath/Expr.pm
+@@ -330,7 +330,7 @@
+
+ sub op_le {
+ my ($node, $lhs, $rhs) = @_;
+- op_gt($node, $rhs, $lhs);
++ op_ge($node, $rhs, $lhs);
+ }
+
+ sub op_ge {
+@@ -359,31 +359,21 @@
+ !$rh_results->isa('XML::XPath::NodeSet'))) {
+ # (that says: one is a nodeset, and one is not a nodeset)
+
+- my ($nodeset, $other);
+- my ($true, $false);
+ if ($lh_results->isa('XML::XPath::NodeSet')) {
+- $nodeset = $lh_results;
+- $other = $rh_results;
+- # we do this because unlike ==, these ops are direction dependant
+- ($false, $true) = (XML::XPath::Boolean->False, XML::XPath::Boolean->True);
++ foreach my $node ($lh_results->get_nodelist) {
++ if ($node->to_number->value >= $rh_results->to_number->value) {
++ return XML::XPath::Boolean->True;
++ }
++ }
+ }
+ else {
+- $nodeset = $rh_results;
+- $other = $lh_results;
+- # ditto above comment
+- ($true, $false) = (XML::XPath::Boolean->False, XML::XPath::Boolean->True);
+- }
+-
+- # True if and only if there is a node in the
+- # nodeset such that the result of performing
+- # the comparison on <type>(string_value($node))
+- # is true.
+- foreach my $node ($nodeset->get_nodelist) {
+- if ($node->to_number->value >= $other->to_number->value) {
+- return $true;
++ foreach my $node ($rh_results->get_nodelist) {
++ if ( $lh_results->to_number->value >= $node->to_number->value) {
++ return XML::XPath::Boolean->True;
++ }
+ }
+ }
+- return $false;
++ return XML::XPath::Boolean->False;
+ }
+ else { # Neither is a nodeset
+ if ($lh_results->isa('XML::XPath::Boolean') ||
+@@ -429,31 +419,21 @@
+ !$rh_results->isa('XML::XPath::NodeSet'))) {
+ # (that says: one is a nodeset, and one is not a nodeset)
+
+- my ($nodeset, $other);
+- my ($true, $false);
+ if ($lh_results->isa('XML::XPath::NodeSet')) {
+- $nodeset = $lh_results;
+- $other = $rh_results;
+- # we do this because unlike ==, these ops are direction dependant
+- ($false, $true) = (XML::XPath::Boolean->False, XML::XPath::Boolean->True);
++ foreach my $node ($lh_results->get_nodelist) {
++ if ($node->to_number->value > $rh_results->to_number->value) {
++ return XML::XPath::Boolean->True;
++ }
++ }
+ }
+ else {
+- $nodeset = $rh_results;
+- $other = $lh_results;
+- # ditto above comment
+- ($true, $false) = (XML::XPath::Boolean->False, XML::XPath::Boolean->True);
+- }
+-
+- # True if and only if there is a node in the
+- # nodeset such that the result of performing
+- # the comparison on <type>(string_value($node))
+- # is true.
+- foreach my $node ($nodeset->get_nodelist) {
+- if ($node->to_number->value > $other->to_number->value) {
+- return $true;
++ foreach my $node ($rh_results->get_nodelist) {
++ if ( $lh_results->to_number->value > $node->to_number->value) {
++ return XML::XPath::Boolean->True;
++ }
+ }
+ }
+- return $false;
++ return XML::XPath::Boolean->False;
+ }
+ else { # Neither is a nodeset
+ if ($lh_results->isa('XML::XPath::Boolean') ||
Modified: trunk/libxml-xpath-perl/debian/patches/series
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libxml-xpath-perl/debian/patches/series?rev=22036&op=diff
==============================================================================
--- trunk/libxml-xpath-perl/debian/patches/series (original)
+++ trunk/libxml-xpath-perl/debian/patches/series Sat Jun 21 12:59:57 2008
@@ -1,1 +1,3 @@
-01-fix_comparison_bug_RT6363.patch
+fix_comparison_bug_RT6363.patch
+example.patch
+test.patch
Added: trunk/libxml-xpath-perl/debian/patches/test.patch
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libxml-xpath-perl/debian/patches/test.patch?rev=22036&op=file
==============================================================================
--- trunk/libxml-xpath-perl/debian/patches/test.patch (added)
+++ trunk/libxml-xpath-perl/debian/patches/test.patch Sat Jun 21 12:59:57 2008
@@ -1,0 +1,55 @@
+--- libxml-xpath-perl-1.13.orig/t/base.t
++++ libxml-xpath-perl-1.13/t/base.t
+@@ -0,0 +1,52 @@
++print "1..6\n";
++use XML::XPath;
++use XML::XPath::Parser;
++use XML::XPath::XMLParser;
++
++# $XML::XPath::Debug = 1;
++
++my $p = XML::XPath->new( filename => 'examples/test.xml' );
++if ($p) { print "ok 1\n"; }
++else { print "not ok 1\n"; }
++
++my $pp = XML::XPath::Parser->new();
++if ($pp) { print "ok 2\n"; }
++else { print "not ok 2\n"; }
++
++$pp->parse("variable('amount', number(number(./rate/text()) * number(./units_worked/text())))");
++
++my $path = $pp->parse('.//
++ tag/
++ child::*/
++ processing-instruction("Fred")/
++ self::node()[substr("33", 1, 1)]/
++ attribute::ra[../@gunk]
++ [(../../@att="va\'l") and (@bert = "geee")]
++ [position() = child::para/fred]
++ [0 -.3]/
++ geerner[(farp | blert)[predicate[@vee]]]');
++
++if ($path) { print "ok 3\n"; }
++else { print "not ok 3\n"; }
++
++#$path = $pp->parse('param|title');
++
++warn "PATH: ", $path->as_string, "\n\n";
++
++if ($path->as_string) { # eq q^(self::node()/descendant-or-self::node()/child::tag/child::*/child::processing-instruction('Fred')/child::id((child::xml/child::vccc/child::bbbb/attribute::fer))/self::node()[(substr(('33'),(1),(1)))]/attribute::ra[(parent::node()/attribute::gunk)][((parent::node()/parent::node()/attribute::att = ('va'l')) and ((attribute::bert = ('geee'))))][(position() = (child::para/child::fred))][(.3)]/child::geerner[((child::fart | (child::blert))[(child::predicate[(attribute::vee)])])])^ ) {
++ print "ok 4\n";
++}
++else { print "not ok 4\n"; }
++
++my $nodes = $p->find('/timesheet//wednesday');
++
++# warn "$nodes size: ", $nodes->size, "\n";
++
++if ($nodes->size) { print "ok 5\n"; }
++else { print "not ok 5\n"; }
++
++foreach my $node ($nodes->get_nodelist) {
++ warn "NODES:\n", XML::XPath::XMLParser::as_string($node), "\n\n";
++}
++
++print "ok 6\n";
Modified: trunk/libxml-xpath-perl/debian/rules
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libxml-xpath-perl/debian/rules?rev=22036&op=diff
==============================================================================
--- trunk/libxml-xpath-perl/debian/rules (original)
+++ trunk/libxml-xpath-perl/debian/rules Sat Jun 21 12:59:57 2008
@@ -1,54 +1,63 @@
#!/usr/bin/make -f
-# Sample debian/rules that uses debhelper.
-# GNU copyright 1997 to 1999 by Joey Hess.
+# This debian/rules file is provided as a template for normal perl
+# packages. It was created by Marc Brockschmidt <marc at dch-faq.de> for
+# the Debian Perl Group (http://pkg-perl.alioth.debian.org/) but may
+# be used freely wherever it is useful.
# Uncomment this to turn on verbose mode.
#export DH_VERBOSE=1
-# This is the debhelper compatibility version to use.
-# export DH_COMPAT=4
-
-PACKAGE=`pwd | sed -e "s/.*\/\\(.*\\)-.*/\\1/"`
+# If set to a true value then MakeMaker's prompt function will
+# always return the default without waiting for user input.
+export PERL_MM_USE_DEFAULT=1
include /usr/share/quilt/quilt.make
-build:
+PERL ?= /usr/bin/perl
+PACKAGE = $(shell dh_listpackages)
+TMP = $(CURDIR)/debian/$(PACKAGE)
+
+build: build-stamp
+build-stamp: $(QUILT_STAMPFN)
dh_testdir
- # Add here commands to compile the package.
- perl Makefile.PL verbose INSTALLDIRS=vendor
+ $(PERL) Makefile.PL INSTALLDIRS=vendor
+ $(MAKE)
+ $(MAKE) test
+ touch $@
-clean:
+clean: unpatch
dh_testdir
dh_testroot
+ dh_clean build-stamp install-stamp
+ [ ! -f Makefile ] || $(MAKE) realclean
- [ ! -f Makefile ] || $(MAKE) clean
- dh_clean Makefile.old
-
-install:
+install: install-stamp
+install-stamp: build-stamp
dh_testdir
dh_testroot
dh_clean -k
- dh_installdirs
+ $(MAKE) install DESTDIR=$(TMP) PREFIX=/usr
+ [ ! -d $(TMP)/usr/lib/perl5 ] || \
+ rmdir --ignore-fail-on-non-empty --parents --verbose \
+ $(TMP)/usr/lib/perl5
+ touch $@
- $(MAKE) PREFIX=$(CURDIR)/debian/$(PACKAGE)/usr OPTIMIZE="-O2 -g -Wall" test install
- [ ! -d $(CURDIR)/debian/$(shell dh_listpackages)/usr/lib/perl5 ] || rmdir --ignore-fail-on-non-empty --parents --verbose $(CURDIR)/debian/$(shell dh_listpackages)/usr/lib/perl5
+binary-arch:
+# We have nothing to do here for an architecture-independent package
-binary-arch:;
binary-indep: build install
dh_testdir
dh_testroot
- dh_installdocs
- dh_installman
+ dh_installexamples examples/*
+ dh_installdocs TODO
dh_installchangelogs
- dh_link
- dh_strip
+ dh_perl
dh_compress
dh_fixperms
dh_installdeb
- dh_perl
dh_gencontrol
dh_md5sums
dh_builddeb
binary: binary-indep binary-arch
-.PHONY: build clean binary-indep binary-arch binary install configure
+.PHONY: build clean binary-indep binary-arch binary install
Modified: trunk/libxml-xpath-perl/examples/xpath
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libxml-xpath-perl/examples/xpath?rev=22036&op=diff
==============================================================================
--- trunk/libxml-xpath-perl/examples/xpath (original)
+++ trunk/libxml-xpath-perl/examples/xpath Sat Jun 21 12:59:57 2008
@@ -1,114 +1,73 @@
#!/usr/bin/perl -w
-
-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) {
+unless (@ARGV >= 1) {
print STDERR qq(Usage:
-$0 [options] -e query [-e query...] [filename...]
+$0 [filename] query
- 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 no filename is given, supply XML on STDIN.
);
exit;
}
-do
-{
- my $xpath;
- my @curpaths = @paths;
- my $filename;
- if (@ARGV >= 1) {
- $filename = shift @ARGV;
- $xpath = XML::XPath->new(filename => $filename);
+use XML::XPath;
+
+my $xpath;
+
+my $pipeline;
+
+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 {
- $filename = 'stdin';
- $xpath = XML::XPath->new(ioref => \*STDIN);
- }
+}
+else {
+ print STDERR "No nodes found";
+}
- 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" unless $quiet;
- }
- }
- else {
- print STDERR "Query didn't return a nodeset. Value: ";
- print $nodes->value, "\n";
- }
-
-} until (@ARGV < 1);
+print STDERR "\n";
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);
@@ -120,83 +79,5 @@
}
}
- return $newnodes;
+ return find_more($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 at 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 at 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 at sergeant.org
-
-This man page was added as well as some serious modifications to the script
-by Fabien Ninoles <fabien at debian.org> for the Debian Project.
-
-=cut
-
More information about the Pkg-perl-cvs-commits
mailing list