Mercurial > repos > iuc > xpath

comparison xpath @ 0:7e01c6a6dbed draft

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
planemo upload for repository https://github.com/galaxyproject/tools-iuc/tree/master/tools/xpath commit e0575333e6f08ef02fc66c2764b43ebd15c6b04b
author iuc
date Fri, 10 Jun 2016 15:08:32 -0400
parents
children 1ba5c66e39c9
comparison
equal deleted inserted replaced
-1:000000000000 0:7e01c6a6dbed
1 #!/usr/bin/perl -w
2 eval 'exec /usr/bin/perl -w -S $0 ${1+"$@"}'
3 if 0; # not running under some shell
4 use strict;
5
6 $| = 1;
7
8 use XML::XPath;
9
10 my @paths;
11 my $pipeline;
12 my $SUFFIX = "\n";
13 my $PREFIX = "";
14 my $quiet = 0;
15
16
17 PARSE: while ((@ARGV >= 1) && ($ARGV[0] =~ /^-./ )) {
18 OPTIONS: {
19 if ($ARGV[0] eq "-e") {
20 shift;
21 push @paths, shift;
22 last OPTIONS;
23 }
24 if ($ARGV[0] eq "-p") {
25 shift;
26 $PREFIX = shift;
27 last OPTIONS;
28 }
29 if ($ARGV[0] eq "-s") {
30 shift;
31 $SUFFIX = shift;
32 last OPTIONS;
33 }
34 if ($ARGV[0] eq "-q") {
35 $quiet = 1;
36 shift;
37 last OPTIONS;
38 }
39 print STDERR "Unknown option ignore: ", shift;
40 }
41 }
42
43 unless (@paths >= 1) {
44 print STDERR qq(Usage:
45 $0 [options] -e query [-e query...] [filename...]
46
47 If no filenams are given, supply XML on STDIN.
48 You must provide at least one query. Each supplementary
49 query is done in order, the previous query giving the
50 context of the next one.
51
52 Options:
53
54 -q quiet. Only output the resulting PATH
55 -s suffix use suffix instead of linefeed.
56 -p postfix use prefix instead of nothing.
57 );
58 exit;
59 }
60
61 do
62 {
63 my $xpath;
64 my @curpaths = @paths;
65 my $filename;
66 if (@ARGV >= 1) {
67 $filename = shift @ARGV;
68 $xpath = XML::XPath->new(filename => $filename);
69 }
70 else {
71 $filename = 'stdin';
72 $xpath = XML::XPath->new(ioref => \*STDIN);
73 }
74
75 my $nodes = $xpath->find(shift @curpaths);
76
77 if ($nodes->isa('XML::XPath::NodeSet')) {
78 while (@curpaths >= 1) {
79 $nodes = find_more($xpath, shift @curpaths, $nodes);
80 last unless $nodes->isa('XML::XPath::NodeSet');
81 }
82 }
83
84 if ($nodes->isa('XML::XPath::NodeSet')) {
85 if ($nodes->size) {
86 print STDERR "Found ", $nodes->size, " nodes in $filename:\n" unless $quiet;
87 foreach my $node ($nodes->get_nodelist) {
88 print STDERR "-- NODE --\n" unless $quiet;
89 print $PREFIX, $node->toString, $SUFFIX;
90 }
91 }
92 else {
93 print STDERR "No nodes found in $filename\n" unless $quiet;
94 }
95 }
96 else {
97 print STDERR "Query didn't return a nodeset. Value: ";
98 print $nodes->value, "\n";
99 }
100
101 } until (@ARGV < 1);
102
103 exit;
104
105 sub find_more {
106 my $xpath = shift;
107 my $find = shift;
108 my ($nodes) = @_;
109
110 my $newnodes = XML::XPath::NodeSet->new;
111
112 foreach my $node ($nodes->get_nodelist) {
113 my $new = $xpath->find($find, $node);
114 if ($new->isa('XML::XPath::NodeSet')) {
115 $newnodes->append($new);
116 }
117 else {
118 warn "Not a nodeset: ", $new->value, "\n";
119 }
120 }
121
122 return $newnodes;
123 }
124
125 __END__
126
127 =head1 NAME
128
129 xpath - a script to query XPath statements in XML documents.
130
131 =head1 SYNOPSIS
132
133 B<xpath [-s suffix] [-p prefix] [-q] -e query [-e query] ... [file] ...>
134
135 =head1 DESCRIPTION
136
137 B<xpath> uses the L<XML::XPath|XML::XPath> perl module to make XPath queries
138 to any XML document. The L<XML::XPath|XML::XPath> module aims to comply exactly
139 to the XPath specification at C<http://www.w3.org/TR/xpath> and yet
140 allows extensions to be added in the form of functions.
141
142 The script takes any number of XPath pointers and tries to apply them
143 to each XML document given on the command line. If no file arguments
144 are given, the query is done using C<STDIN> as an XML document.
145
146 When multiple queries exist, the result of the last query is used as
147 context for the next query and only the result of the last one is output.
148 The context of the first query is always the root of the current document.
149
150 =head1 OPTIONS
151
152 =head2 B<-q>
153
154 Be quiet. Output only errors (and no separator) on stderr.
155
156 =head2 B<-s suffix>
157
158 Place C<suffix> at the end of each entry. Default is a linefeed.
159
160 =head2 B<-p prefix>
161
162 Place C<prefix> preceding each entry. Default is nothing.
163
164 =head1 BUGS
165
166 The author of this man page is not very fluant in english. Please,
167 send him (L<fabien@tzone.org>) any corrections concerning this text.
168
169 See also L<XML::XPath(3pm)>.
170
171 =head1 SEE ALSO
172
173 L<XML::XPath(3pm)>.
174
175 =head1 HISTORY
176
177 This module is copyright 2000 Fastnet Software Ltd. This is free
178 software, and as such comes with NO WARRANTY. No dates are used in this
179 module. You may distribute this module under the terms of either the
180 Gnu GPL, or under specific licencing from Fastnet Software Ltd.
181 Special free licencing consideration will be given to similarly free
182 software. Please don't flame me for this licence - I've put a lot of
183 hours into this code, and if someone uses my software in their product
184 I expect them to have the courtesy to contact me first.
185
186 Full support for this module is available from Fastnet Software Ltd on
187 a pay per incident basis. Alternatively subscribe to the Perl-XML
188 mailing list by mailing lyris@activestate.com with the text:
189
190 SUBSCRIBE Perl-XML
191
192 in the body of the message. There are lots of friendly people on the
193 list, including myself, and we'll be glad to get you started.
194
195 Matt Sergeant, matt@sergeant.org
196
197 This man page was added as well as some serious modifications to the script
198 by Fabien Ninoles <fabien@debian.org> for the Debian Project.
199
200 =cut
201