line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# $Id: Node.pm,v 1.4 2007/10/05 12:13:05 mike Exp $ |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
package Net::Z3950::PQF::Node; |
4
|
|
|
|
|
|
|
|
5
|
3
|
|
|
3
|
|
17
|
use strict; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
103
|
|
6
|
3
|
|
|
3
|
|
16
|
use warnings; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
3557
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=head1 NAME |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
Net::Z3950::PQF::Node - Abstract class for nodes in a PQF parse tree |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
=head1 SYNOPSIS |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
$node = new Net::Z3950::PQF::TermNode('unix'); |
16
|
|
|
|
|
|
|
$node->isa("Net::Z3950::PQF::Node") or die "oops"; |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=head1 DESCRIPTION |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
This module implements the types for the nodes that make up a PQF |
21
|
|
|
|
|
|
|
parse tree. Each such concrete type is a subclass of the abstract |
22
|
|
|
|
|
|
|
base class |
23
|
|
|
|
|
|
|
C, |
24
|
|
|
|
|
|
|
and has a type whose name is of the form |
25
|
|
|
|
|
|
|
CI. |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
The following node types are defined: |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
=over 4 |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
=item C |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
Represents an actual query term such as |
34
|
|
|
|
|
|
|
C, |
35
|
|
|
|
|
|
|
C<"brian"> |
36
|
|
|
|
|
|
|
or |
37
|
|
|
|
|
|
|
C<"Brian W. Kernighan">. |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
The term is accompanied by zero or more |
40
|
|
|
|
|
|
|
I, |
41
|
|
|
|
|
|
|
each of which is a triple represented by a reference to a |
42
|
|
|
|
|
|
|
three-element array. Each such array consists of an |
43
|
|
|
|
|
|
|
I |
44
|
|
|
|
|
|
|
which may be either an OID or a short descriptive string, |
45
|
|
|
|
|
|
|
an integer |
46
|
|
|
|
|
|
|
I, |
47
|
|
|
|
|
|
|
and a |
48
|
|
|
|
|
|
|
I |
49
|
|
|
|
|
|
|
which may be either an integer or a string. |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
=item C |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
Represents a result-set node, a reference to the name of a prior |
54
|
|
|
|
|
|
|
result set. The result-set name is accompanied by zero or more |
55
|
|
|
|
|
|
|
attributes as above. |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
=item C |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
Represents an AND node with two sub-nodes. |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
=item C |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
Represents an OR node with two sub-nodes. |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
=item C |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
Represents a NOT node with two sub-nodes. In the Z39.50 Type-1 query, |
68
|
|
|
|
|
|
|
and hence in PQF, NOT is a binary AND-NOT operator rather than than a |
69
|
|
|
|
|
|
|
unary negation operator. |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=item C |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
Represents a proximity node with two subnodes and five parameters: |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
I: |
76
|
|
|
|
|
|
|
a boolean indicating whether the condition indicated by the other |
77
|
|
|
|
|
|
|
parameters should be inverted. |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
I: |
80
|
|
|
|
|
|
|
an integer indicating the number of units that may separate the |
81
|
|
|
|
|
|
|
fragments identified by the subnodes. |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
I: |
84
|
|
|
|
|
|
|
a boolean indicating whether the elements indicated by the subnodes |
85
|
|
|
|
|
|
|
are constrained to be in the same order as the subnodes themselves. |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
I: |
88
|
|
|
|
|
|
|
indicates the relation required on the specified distance in order |
89
|
|
|
|
|
|
|
for the condition to be satisfied. |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
I: |
92
|
|
|
|
|
|
|
a short string indicating the units of proximity (C, |
93
|
|
|
|
|
|
|
C, etc.) |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=back |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
Except where noted, the methods described below are defined for all of |
98
|
|
|
|
|
|
|
the concrete node types. |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
=head1 METHODS |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
=head2 new() |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
$term1 = new Net::Z3950::PQF::TermNode('brian', [ "bib-1", 1, 1003 ]); |
106
|
|
|
|
|
|
|
$term2 = new Net::Z3950::PQF::TermNode('unix', [ "bib-1", 1, 4 ]); |
107
|
|
|
|
|
|
|
$and = new Net::Z3950::PQF::AndNode($term1, $term2); |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
Creates a new node object of the appropriate type. It is not possible |
110
|
|
|
|
|
|
|
to instantiate the abstract node type, C, only its |
111
|
|
|
|
|
|
|
concrete subclasses. |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
The parameters required are different for different node types: |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
=over 4 |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
=item C |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
The first parameter is the actual term, and the remainder are |
120
|
|
|
|
|
|
|
attributes, each represented by a triple of |
121
|
|
|
|
|
|
|
[ I, I, I ]. |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
=item C, C, C |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
The two parameters are nodes representing the subtrees. |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
=item C |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
The seven parameters are, in order: the two nodes representing the |
130
|
|
|
|
|
|
|
subtrees, and the five parameters exclusion, distance, ordered, |
131
|
|
|
|
|
|
|
relation and unit. |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
=back |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
=cut |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
sub new { |
138
|
0
|
|
|
0
|
1
|
0
|
my $class = shift(); |
139
|
0
|
|
|
|
|
0
|
die "can't create an abstract $class"; |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
=head2 render() |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
$node->render(0); |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
Renders the contents of the tree rooted at the specified node, |
148
|
|
|
|
|
|
|
indented to a level indicated by the parameter. This output is in a |
149
|
|
|
|
|
|
|
human-readable form that is useful for debugging but probably not much |
150
|
|
|
|
|
|
|
else. |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
=cut |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
sub render { |
155
|
0
|
|
|
0
|
1
|
0
|
my $class = shift(); |
156
|
0
|
|
|
|
|
0
|
die "can't render an abstract $class"; |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
=head2 toSimpleServer() |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
$node->toSimpleServer(); |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
Transforms the contents of the tree rooted at the specified node, |
165
|
|
|
|
|
|
|
returning a correpsonding tree of the Perl structures produced by the |
166
|
|
|
|
|
|
|
Net::Z3950::SimpleServer module and passed as the {RPN} argument to |
167
|
|
|
|
|
|
|
search handlers. This emulation is useful for testing code that |
168
|
|
|
|
|
|
|
expects to receive queries in that format. |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
=cut |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
sub toSimpleServer { |
173
|
0
|
|
|
0
|
1
|
0
|
my $class = shift(); |
174
|
0
|
|
|
|
|
0
|
die "can't translate an abstract $class into SimpleServer form"; |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
# PRIVATE base class, used as base by TermNode and RsetNode |
180
|
|
|
|
|
|
|
package Net::Z3950::PQF::LeafNode; |
181
|
|
|
|
|
|
|
our @ISA = qw(Net::Z3950::PQF::Node); |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
sub new { |
184
|
37
|
|
|
37
|
|
997
|
my $class = shift(); |
185
|
37
|
|
|
|
|
68
|
my($value, @attrs) = @_; |
186
|
|
|
|
|
|
|
|
187
|
37
|
|
|
|
|
340
|
return bless { |
188
|
|
|
|
|
|
|
value => $value, |
189
|
|
|
|
|
|
|
attrs => [ @attrs ], |
190
|
|
|
|
|
|
|
}, $class; |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
sub render { |
194
|
39
|
|
|
39
|
|
7282
|
my $this = shift(); |
195
|
39
|
|
|
|
|
64
|
my($level) = @_; |
196
|
|
|
|
|
|
|
|
197
|
39
|
50
|
|
|
|
110
|
die "render() called with no level" if !defined $level; |
198
|
39
|
|
|
|
|
172
|
my $text = ("\t" x $level) . $this->_name() . ": " . $this->{value} . "\n"; |
199
|
39
|
|
|
|
|
48
|
foreach my $attr (@{ $this->{attrs} }) { |
|
39
|
|
|
|
|
92
|
|
200
|
34
|
|
|
|
|
55
|
my($set, $type, $val) = @$attr; |
201
|
34
|
|
|
|
|
123
|
$text .= ("\t" x ($level+1)) . "attr: $set $type=$val\n"; |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
|
204
|
39
|
|
|
|
|
122
|
return $text; |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
sub toSimpleServer { |
208
|
3
|
|
|
3
|
|
4
|
my $this = shift(); |
209
|
|
|
|
|
|
|
|
210
|
3
|
|
|
|
|
22
|
my $attrs = bless [], "Net::Z3950::RPN::Attributes"; |
211
|
3
|
|
|
|
|
4
|
foreach my $attr (@{ $this->{attrs} }) { |
|
3
|
|
|
|
|
18
|
|
212
|
3
|
|
|
|
|
5
|
my($set, $type, $val) = @$attr; |
213
|
3
|
|
|
|
|
21
|
push @$attrs, bless { |
214
|
|
|
|
|
|
|
attributeSet => $set, |
215
|
|
|
|
|
|
|
attributeType => $type, |
216
|
|
|
|
|
|
|
attributeValue => $val, |
217
|
|
|
|
|
|
|
}, "Net::Z3950::RPN::Attribute"; |
218
|
|
|
|
|
|
|
} |
219
|
|
|
|
|
|
|
|
220
|
3
|
|
|
|
|
10
|
return bless { |
221
|
|
|
|
|
|
|
$this->_ssname() => $this->{value}, |
222
|
|
|
|
|
|
|
attributes => $attrs, |
223
|
|
|
|
|
|
|
}, $this->_ssclass(); |
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
package Net::Z3950::PQF::TermNode; |
229
|
|
|
|
|
|
|
our @ISA = qw(Net::Z3950::PQF::LeafNode); |
230
|
|
|
|
|
|
|
|
231
|
36
|
|
|
36
|
|
119
|
sub _name { "term" } |
232
|
2
|
|
|
2
|
|
296
|
sub _ssname { "term" } |
233
|
2
|
|
|
2
|
|
57
|
sub _ssclass { "Net::Z3950::RPN::Term" } |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
package Net::Z3950::PQF::RsetNode; |
238
|
|
|
|
|
|
|
our @ISA = qw(Net::Z3950::PQF::LeafNode); |
239
|
|
|
|
|
|
|
|
240
|
3
|
|
|
3
|
|
26
|
sub _name { "rset" } |
241
|
1
|
|
|
1
|
|
7
|
sub _ssname { "id" } |
242
|
1
|
|
|
1
|
|
7
|
sub _ssclass { "Net::Z3950::RPN::RSID" } |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
# PRIVATE class, used as base by AndNode, OrNode and NotNode |
247
|
|
|
|
|
|
|
package Net::Z3950::PQF::BooleanNode; |
248
|
|
|
|
|
|
|
our @ISA = qw(Net::Z3950::PQF::Node); |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
sub new { |
251
|
14
|
|
|
14
|
|
799
|
my $class = shift(); |
252
|
14
|
|
|
|
|
28
|
my(@sub) = @_; |
253
|
|
|
|
|
|
|
|
254
|
14
|
|
|
|
|
89
|
return bless { |
255
|
|
|
|
|
|
|
sub => [ @sub ], |
256
|
|
|
|
|
|
|
}, $class; |
257
|
|
|
|
|
|
|
} |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
sub render { |
260
|
13
|
|
|
13
|
|
10669
|
my $this = shift(); |
261
|
13
|
|
|
|
|
31
|
my($level) = @_; |
262
|
|
|
|
|
|
|
|
263
|
13
|
50
|
|
|
|
34
|
die "render() called with no level" if !defined $level; |
264
|
13
|
|
|
|
|
40
|
my $text = ("\t" x $level) . $this->_op() . "\n"; |
265
|
13
|
|
|
|
|
22
|
foreach my $sub (@{ $this->{sub} }) { |
|
13
|
|
|
|
|
58
|
|
266
|
26
|
|
|
|
|
73
|
$text .= $sub->render($level+1); |
267
|
|
|
|
|
|
|
} |
268
|
|
|
|
|
|
|
|
269
|
13
|
|
|
|
|
48
|
return $text; |
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
sub toSimpleServer { |
273
|
2
|
|
|
2
|
|
12
|
my $this = shift(); |
274
|
|
|
|
|
|
|
|
275
|
2
|
|
|
|
|
2
|
my $res; |
276
|
2
|
|
|
|
|
4
|
foreach my $sub (@{ $this->{sub} }) { |
|
2
|
|
|
|
|
18
|
|
277
|
4
|
|
|
|
|
35
|
push @$res, $sub->toSimpleServer(); |
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
|
280
|
2
|
|
|
|
|
7
|
return bless $res, $this->_ssclass(); |
281
|
|
|
|
|
|
|
} |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
package Net::Z3950::PQF::AndNode; |
286
|
|
|
|
|
|
|
our @ISA = qw(Net::Z3950::PQF::BooleanNode); |
287
|
|
|
|
|
|
|
|
288
|
4
|
|
|
4
|
|
10
|
sub _op { "and" } |
289
|
1
|
|
|
1
|
|
10
|
sub _ssclass { "Net::Z3950::RPN::And" } |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
package Net::Z3950::PQF::OrNode; |
294
|
|
|
|
|
|
|
our @ISA = qw(Net::Z3950::PQF::BooleanNode); |
295
|
|
|
|
|
|
|
|
296
|
9
|
|
|
9
|
|
25
|
sub _op { "or" } |
297
|
1
|
|
|
1
|
|
12
|
sub _ssclass { "Net::Z3950::RPN::Or" } |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
package Net::Z3950::PQF::NotNode; |
302
|
|
|
|
|
|
|
our @ISA = qw(Net::Z3950::PQF::BooleanNode); |
303
|
|
|
|
|
|
|
|
304
|
0
|
|
|
0
|
|
|
sub _op { "not" } |
305
|
0
|
|
|
0
|
|
|
sub _ssclass { "Net::Z3950::RPN::AndNote" } |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
package Net::Z3950::PQF::ProxNode; |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
sub new { |
312
|
0
|
|
|
0
|
|
|
my $class = shift(); |
313
|
0
|
|
|
|
|
|
die "### class $class not yet implemented"; |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
sub render { |
317
|
0
|
|
|
0
|
|
|
my $this = shift(); |
318
|
0
|
|
|
|
|
|
die "you shouldn't have been able to make $this"; |
319
|
|
|
|
|
|
|
} |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
=head1 PROVENANCE |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
This module is part of the Net::Z3950::PQF distribution. The |
327
|
|
|
|
|
|
|
copyright, authorship and licence are all as for the distribution. |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
=cut |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
1; |