-# $Id: PQF.pm,v 1.1 2004-12-17 13:44:47 mike Exp $
+# $Id: PQF.pm,v 1.4 2004-12-17 17:12:05 mike Exp $
package Net::Z3950::PQF;
use strict;
use warnings;
-#use Net::Z3950::PQF::Node;
+use Net::Z3950::PQF::Node;
our $VERSION = '0.02';
use Net::Z3950::PQF;
$parser = new Net::Z3950::PQF();
$node = $parser->parse('@and @attr 1=1003 kernighan @attr 1=4 unix');
- print $node->render();
+ print $node->render(0);
=head1 DESCRIPTION
but precise string format for expressing Z39.50 Type-1 queries. This
format is widely used behind the scenes of Z39.50 applications, and is
also used extensively with test-harness programs such as the YAZ
-command-line client, C<yaz-client>.
+command-line client, C<yaz-client>. A few particularly misguided
+souls have been known to type it by hand.
-It is simple to use. Create a parser object, then pass PQF strings
+Unlike PQF itself, this module
+is simple to use. Create a parser object, then pass PQF strings
into its C<parse()> method to yield parse-trees. The trees are made
-up of nodes whose types are all of the form
-C<Net::Z3950::PQF::xxxNode>. You may find it helpful to use
+up of nodes whose types are subclasses of
+C<Net::Z3950::PQF::Node>.
+and have names of the form
+C<Net::Z3950::PQF::somethingNode>. You may find it helpful to use
C<Data::Dumper> to visualise the structure of the returned
parse-trees.
my $class = shift();
return bless {
+ text => undef,
errmsg => undef,
}, $class;
}
$query = '@and @attr 1=1003 kernighan @attr 1=4 unix';
$node = $parser->parse($query);
- if (!defined $node)
+ if (!defined $node) {
die "parse($query) failed: " . $parser->errmsg();
- }
+ }
Parses the PQF string provided as its argument. If an error occurs,
then an undefined value is returned, and the error message can be
obtained by calling the C<errmsg()> method. Otherwise, the top node
of the parse tree is returned.
+ $node2 = $parser->parse($query, "zthes");
+ $node3 = $parser->parse($query, "1.2.840.10003.3.13");
+
+A second argument may be provided after the query itself. If it is
+provided, then it is taken to be either the name or the OID of a
+default attribute set, which attributes specified in the query belong
+to if no alternative attribute set is explicitly specified within the
+query. When this second argument is absent, the default attribute set
+is BIB-1.
+
=cut
sub parse {
my $this = shift();
+ my($text, $attrset) = @_;
+ $attrset = "bib-1" if !defined $attrset;
+
+ $this->{text} = $text;
+ return $this->_parse($attrset, {});
+}
+
+
+# PRIVATE to parse();
+#
+# Underlying parse function. $attrset is the default attribute-set to
+# use for attributes that are not specified with an explicit set, and
+# $attrhash is hash of attributes (at most one per type per
+# attribute-set) to be applied to all nodes below this point. The
+# keys of this hash are of the form "<attrset>:<type>" and the values
+# are the corresponding attribute values.
+#
+sub _parse {
+ my $this = shift();
+ my($attrset, $attrhash) = @_;
+
+ ### This rather nasty hack for quoted terms doesn't recognised
+ # backslash-quoted embedded double quotes.
+ $this->{text} =~ s/^\s+//;
+ if ($this->{text} =~ s/^"(.*?)"//) {
+ return $this->_term($1, $attrhash);
+ }
+
+ my $word = $this->_word();
+ if ($word eq '@attrset') {
+ $attrset = $this->_word();
+ return $this->_parse($attrset, $attrhash);
+
+ } elsif ($word eq '@attr') {
+ $word = $this->_word();
+ if ($word !~ /=/) {
+ $attrset = $word;
+ $word = $this->_word();
+ }
+ my($type, $val) = ($word =~ /(.*)=(.*)/);
+ my %h = %$attrhash;
+ $h{"$attrset:$type"} = $val;
+ return $this->_parse($attrset, \%h);
+
+ } elsif ($word eq '@and' || $word eq '@or' || $word eq '@not') {
+ my $sub1 = $this->_parse($attrset, $attrhash);
+ my $sub2 = $this->_parse($attrset, $attrhash);
+ if ($word eq '@and') {
+ return new Net::Z3950::PQF::AndNode($sub1, $sub2);
+ } elsif ($word eq '@or') {
+ return new Net::Z3950::PQF::OrNode($sub1, $sub2);
+ } elsif ($word eq '@not') {
+ return new Net::Z3950::PQF::NotNode($sub1, $sub2);
+ } else {
+ die "Houston, we have a problem";
+ }
+
+ } elsif ($word eq '@prox') {
+ return $this->_error("proximity not yet implemented");
+
+ }
+
+ # It must be a bareword
+ return $this->_term($word, $attrhash);
+}
+
+
+# PRIVATE to _parse();
+sub _word {
+ my $this = shift();
+
+ $this->{text} =~ s/^\s+//;
+ $this->{text} =~ s/^(\S+)//;
+ return $1;
+}
+
+
+# PRIVATE to _parse();
+sub _error {
+ my $this = shift();
+ my (@msg) = @_;
- die "parse($this) not yet implemented";
+ $this->{errmsg} = join("", @msg);
+ return undef;
+}
+
+
+# PRIVATE to _parse();
+sub _term {
+ my $this = shift();
+ my($word, $attrhash) = @_;
+
+ my @attrs;
+ foreach my $key (sort keys %$attrhash) {
+ my($attrset, $type) = split /:/, $key;
+ push @attrs, [ $attrset, $type, $attrhash->{$key} ];
+ }
+
+ return new Net::Z3950::PQF::TermNode($word, @attrs);
}
print $parser->errmsg();
+Returns the last error-message generated by a failed attempt to parse
+a query.
+
=cut
sub errmsg {
=head1 SEE ALSO
+The C<Net::Z3950::PQF::Node> module.
+
The definition of the Type-1 query in the Z39.50 standard, the
relevant section of which is on-line at
http://www.loc.gov/z3950/agency/markup/09.html#3.7
Copyright 2004 by Index Data ApS.
This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
+it under the same terms as Perl itself.
=cut
+
+
+1;
projects / perl-pqf.git / blobdiff