1 # $Id: PQF.pm,v 1.3 2004-12-17 16:58:09 mike Exp $
3 package Net::Z3950::PQF;
9 use Net::Z3950::PQF::Node;
11 our $VERSION = '0.02';
16 Net::Z3950::PQF - Perl extension for parsing PQF (Prefix Query Format)
21 $parser = new Net::Z3950::PQF();
22 $node = $parser->parse('@and @attr 1=1003 kernighan @attr 1=4 unix');
23 print $node->render(0);
27 This library provides a parser for PQF (Prefix Query Format), an ugly
28 but precise string format for expressing Z39.50 Type-1 queries. This
29 format is widely used behind the scenes of Z39.50 applications, and is
30 also used extensively with test-harness programs such as the YAZ
31 command-line client, C<yaz-client>.
33 It is simple to use. Create a parser object, then pass PQF strings
34 into its C<parse()> method to yield parse-trees. The trees are made
35 up of nodes whose types are subclasses of
36 C<Net::Z3950::PQF::Node>.
37 and have names of the form
38 C<Net::Z3950::PQF::somethingNode>. You may find it helpful to use
39 C<Data::Dumper> to visualise the structure of the returned
42 What is a PQF parse-tree good for? Not much. You can render a
43 human-readable version by invoking the top node's C<render()> method,
44 which is probably useful only for debugging. If you want to do
45 anything useful, such as implementing an actual query server that
46 understands PQF, you'll have to walk the tree.
52 $parser = new Net::Z3950::PQF();
54 Creates a new parser object.
70 $query = '@and @attr 1=1003 kernighan @attr 1=4 unix';
71 $node = $parser->parse($query);
73 die "parse($query) failed: " . $parser->errmsg();
76 Parses the PQF string provided as its argument. If an error occurs,
77 then an undefined value is returned, and the error message can be
78 obtained by calling the C<errmsg()> method. Otherwise, the top node
79 of the parse tree is returned.
81 $node2 = $parser->parse($query, "zthes");
82 $node3 = $parser->parse($query, "1.2.840.10003.3.13");
84 A second argument may be provided, after the query itself. If it is
85 provided, then it is taken to be either the name or the OID of a
86 default attribute set, which attributes specified in the query belong
87 to if no alternative attribute set is explicitly specified. When this
88 second argument is absent, the default attribute set is BIB-1.
94 my($text, $attrset) = @_;
95 $attrset = "bib-1" if !defined $attrset;
97 $this->{text} = $text;
98 return $this->_parse($attrset, {});
102 # PRIVATE to parse();
104 # Underlying parse function. $attrset is the default attribute-set to
105 # use for attributes that are not specified with an explicit set, and
106 # $attrhash is hash of attributes (at most one per type per
107 # attribute-set) to be applied to all nodes below this point. The
108 # keys of this hash are of the form "<attrset>:<type>" and the values
109 # are the corresponding attribute values.
113 my($attrset, $attrhash) = @_;
115 ### This rather nasty hack for quoted terms doesn't recognised
116 # backslash-quoted embedded double quotes.
117 $this->{text} =~ s/^\s+//;
118 if ($this->{text} =~ s/^"(.*?)"//) {
119 return $this->_term($1, $attrhash);
122 my $word = $this->_word();
123 if ($word eq '@attrset') {
124 $attrset = $this->_word();
125 return $this->_parse($attrset, $attrhash);
127 } elsif ($word eq '@attr') {
128 $word = $this->_word();
131 $word = $this->_word();
133 my($type, $val) = ($word =~ /(.*)=(.*)/);
135 $h{"$attrset:$type"} = $val;
136 return $this->_parse($attrset, \%h);
138 } elsif ($word eq '@and' || $word eq '@or' || $word eq '@not') {
139 my $sub1 = $this->_parse($attrset, $attrhash);
140 my $sub2 = $this->_parse($attrset, $attrhash);
141 if ($word eq '@and') {
142 return new Net::Z3950::PQF::AndNode($sub1, $sub2);
143 } elsif ($word eq '@or') {
144 return new Net::Z3950::PQF::OrNode($sub1, $sub2);
145 } elsif ($word eq '@not') {
146 return new Net::Z3950::PQF::NotNode($sub1, $sub2);
148 die "Houston, we have a problem";
151 } elsif ($word eq '@prox') {
152 return $this->_error("proximity not yet implemented");
156 # It must be a bareword
157 return $this->_term($word, $attrhash);
161 # PRIVATE to _parse();
165 $this->{text} =~ s/^\s+//;
166 $this->{text} =~ s/^(\S+)//;
171 # PRIVATE to _parse();
176 $this->{errmsg} = join(@msg);
181 # PRIVATE to _parse();
184 my($word, $attrhash) = @_;
187 foreach my $key (sort keys %$attrhash) {
188 my($attrset, $type) = split /:/, $key;
189 push @attrs, [ $attrset, $type, $attrhash->{$key} ];
192 return new Net::Z3950::PQF::TermNode($word, @attrs);
198 print $parser->errmsg();
204 return $this->{errmsg};
210 The definition of the Type-1 query in the Z39.50 standard, the
211 relevant section of which is on-line at
212 http://www.loc.gov/z3950/agency/markup/09.html#3.7
214 The documentation of Prefix Query Format in the YAZ Manual, the
215 relevant section of which is on-line at
216 http://indexdata.com/yaz/doc/tools.tkl#PQF
220 Mike Taylor, E<lt>mike@indexdata.comE<gt>
222 =head1 COPYRIGHT AND LICENSE
224 Copyright 2004 by Index Data ApS.
226 This library is free software; you can redistribute it and/or modify
227 it under the same terms as Perl itself.