Support for Rset nodes and forparsing @set, test scripts

diff --git a/Changes b/Changes
index 038dcbf..adcc727 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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<value>
 which may be either an integer or a string.
 
+=item C<RsetNode>
+
+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<AndNode>
 
 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 (file)
--- 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 (file)
--- 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',