From: Mike Taylor Date: Mon, 20 Dec 2004 09:46:58 +0000 (+0000) Subject: Support for Rset nodes and forparsing @set, test scripts X-Git-Url: http://sru.miketaylor.org.uk/cgi-bin?a=commitdiff_plain;h=3401abe45a0a32a9ce67cfb6bcd74318daf36980;p=perl-pqf.git Support for Rset nodes and forparsing @set, test scripts --- diff --git a/Changes b/Changes index 038dcbf..adcc727 100644 --- a/Changes +++ b/Changes @@ -1,12 +1,16 @@ -$Id: Changes,v 1.5 2004-12-20 09:23:44 mike Exp $ +$Id: Changes,v 1.6 2004-12-20 09:46:58 mike Exp $ Revision history for Perl extension Net::Z3950::PQF. 0.03 (IN PROGRESS) - Net::Z3950::PQF::TermNode and Net::Z3950::PQF::BooleanNode - are now subclasses or Net::Z3950::PQF::BooleanNode as + are now subclasses of Net::Z3950::PQF::BooleanNode as documented. - Test script "t/1-node.t" now tests subclassness. + - Support for Rset nodes. + - Test script "t/1-node.t" now tests Rset nodes. + - Support for parsing @set. + - Test script "t/2-parser.t" now tests @set queries. 0.02 Fri Dec 17 17:17:47 GMT 2004 - Add CVS Ids. @@ -21,6 +25,5 @@ Revision history for Perl extension Net::Z3950::PQF. protect embedded double quotes. Support for creating and rendering ProxNode. Support for parsing @prox. - Support for parsing @set. Support for parsing @term. diff --git a/lib/Net/Z3950/PQF.pm b/lib/Net/Z3950/PQF.pm index eff7aab..eb1a8fe 100644 --- a/lib/Net/Z3950/PQF.pm +++ b/lib/Net/Z3950/PQF.pm @@ -1,4 +1,4 @@ -# $Id: PQF.pm,v 1.5 2004-12-20 09:22:12 mike Exp $ +# $Id: PQF.pm,v 1.6 2004-12-20 09:46:58 mike Exp $ package Net::Z3950::PQF; @@ -119,7 +119,7 @@ sub _parse { # backslash-quoted embedded double quotes. $this->{text} =~ s/^\s+//; if ($this->{text} =~ s/^"(.*?)"//) { - return $this->_term($1, $attrhash); + return $this->_leaf('term', $1, $attrhash); } my $word = $this->_word(); @@ -154,10 +154,13 @@ sub _parse { } elsif ($word eq '@prox') { return $this->_error("proximity not yet implemented"); + } elsif ($word eq '@set') { + $word = $this->_word(); + return $this->_leaf('rset', $word, $attrhash); } # It must be a bareword - return $this->_term($word, $attrhash); + return $this->_leaf('term', $word, $attrhash); } @@ -182,9 +185,9 @@ sub _error { # PRIVATE to _parse(); -sub _term { +sub _leaf { my $this = shift(); - my($word, $attrhash) = @_; + my($type, $word, $attrhash) = @_; my @attrs; foreach my $key (sort keys %$attrhash) { @@ -192,7 +195,13 @@ sub _term { push @attrs, [ $attrset, $type, $attrhash->{$key} ]; } - return new Net::Z3950::PQF::TermNode($word, @attrs); + if ($type eq 'term') { + return new Net::Z3950::PQF::TermNode($word, @attrs); + } elsif ($type eq 'rset') { + return new Net::Z3950::PQF::RsetNode($word, @attrs); + } else { + die "_leaf() called with type='$type' (should be 'term' or 'rset')"; + } } diff --git a/lib/Net/Z3950/PQF/Node.pm b/lib/Net/Z3950/PQF/Node.pm index 41ede95..adaa46c 100644 --- a/lib/Net/Z3950/PQF/Node.pm +++ b/lib/Net/Z3950/PQF/Node.pm @@ -1,4 +1,4 @@ -# $Id: Node.pm,v 1.2 2004-12-20 09:23:11 mike Exp $ +# $Id: Node.pm,v 1.3 2004-12-20 09:46:58 mike Exp $ package Net::Z3950::PQF::Node; @@ -48,6 +48,12 @@ and a I which may be either an integer or a string. +=item C + +Represents a result-set node, a reference to the name of a prior +result set. The result-set name is accompanied by zero or more +attributes as above. + =item C Represents an AND node with two sub-nodes. @@ -152,15 +158,16 @@ sub render { -package Net::Z3950::PQF::TermNode; +# PRIVATE base class, used as base by TermNode and RsetNode +package Net::Z3950::PQF::LeafNode; our @ISA = qw(Net::Z3950::PQF::Node); sub new { my $class = shift(); - my($term, @attrs) = @_; + my($value, @attrs) = @_; return bless { - term => $term, + value => $value, attrs => [ @attrs ], }, $class; } @@ -170,7 +177,7 @@ sub render { my($level) = @_; die "render() called with no level" if !defined $level; - my $text = ("\t" x $level) . "term: " . $this->{term} . "\n"; + my $text = ("\t" x $level) . $this->_name() . ": " . $this->{value} . "\n"; foreach my $attr (@{ $this->{attrs} }) { my($set, $type, $val) = @$attr; $text .= ("\t" x ($level+1)) . "attr: $set $type=$val\n"; @@ -181,6 +188,20 @@ sub render { +package Net::Z3950::PQF::TermNode; +our @ISA = qw(Net::Z3950::PQF::LeafNode); + +sub _name { "term" } + + + +package Net::Z3950::PQF::RsetNode; +our @ISA = qw(Net::Z3950::PQF::LeafNode); + +sub _name { "rset" } + + + # PRIVATE class, used as base by AndNode, OrNode and NotNode package Net::Z3950::PQF::BooleanNode; our @ISA = qw(Net::Z3950::PQF::Node); diff --git a/t/1-node.t b/t/1-node.t index 2a53374..94c617b 100644 --- a/t/1-node.t +++ b/t/1-node.t @@ -1,8 +1,8 @@ -# $Id: 1-node.t,v 1.3 2004-12-20 09:23:58 mike Exp $ +# $Id: 1-node.t,v 1.4 2004-12-20 09:46:58 mike Exp $ use strict; use warnings; -use Test::More tests => 14; +use Test::More tests => 17; BEGIN { use_ok('Net::Z3950::PQF') }; my $term1 = new Net::Z3950::PQF::TermNode('unix'); @@ -19,6 +19,14 @@ $text = $term2->render(0); ok($text eq "term: elements\n\tattr: bib-1 1=21\n\tattr: bib-1 2=3\n", "rendered 'term' node with attrs"); +my $rset = new Net::Z3950::PQF::RsetNode('oldRsetName', + [ "bib-1", 1, 1003 ]); +ok(defined $rset, "created 'rset' node with attrs"); +ok($rset->isa("Net::Z3950::PQF::Node"), "'rset' is a node"); +$text = $rset->render(0); +ok($text eq "rset: oldRsetName\n\tattr: bib-1 1=1003\n", + "rendered 'rset' node with attrs"); + my $or = new Net::Z3950::PQF::OrNode($term1, $term2); ok(defined $or, "created 'or' node"); ok($or->isa("Net::Z3950::PQF::BooleanNode"), "'or' is a boolean node"); diff --git a/t/2-parser.t b/t/2-parser.t index 40c421e..7480199 100644 --- a/t/2-parser.t +++ b/t/2-parser.t @@ -1,4 +1,4 @@ -# $Id: 2-parser.t,v 1.2 2004-12-17 16:56:59 mike Exp $ +# $Id: 2-parser.t,v 1.3 2004-12-20 09:46:58 mike Exp $ use strict; use warnings; @@ -20,6 +20,10 @@ BEGIN { "term: brian\n\tattr: bib-1 1=1003\n\tattr: bib-1 2=3" ], [ '@and brian dennis', "and\n\tterm: brian\n\tterm: dennis" ], + [ '@set foo123', + "rset: foo123" ], + [ '@attr 1=1003 @set foo123', + "rset: foo123\n\tattr: bib-1 1=1003" ], [ '@or brian dennis', "or\n\tterm: brian\n\tterm: dennis" ], [ '@or ken @and brian dennis',