X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=lib%2FNet%2FZ3950%2FPQF%2FNode.pm;h=c5d000494d1ea75fb4703fc09f6538f5783b9d6a;hb=f117766f6b68d479b8c96fd2e008d2cf805a57bb;hp=41ede956cfd7fa36d4edc8dd14a23bedb97c0a2d;hpb=ce04c9e68204d3b593b1b8182e2d35ed42eb6951;p=perl-pqf.git

diff --git a/lib/Net/Z3950/PQF/Node.pm b/lib/Net/Z3950/PQF/Node.pm
index 41ede95..c5d0004 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.4 2007-10-05 12:13:05 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.
@@ -151,16 +157,35 @@ sub render {
 }
 
 
+=head2 toSimpleServer()
 
-package Net::Z3950::PQF::TermNode;
+ $node->toSimpleServer();
+
+Transforms the contents of the tree rooted at the specified node,
+returning a correpsonding tree of the Perl structures produced by the
+Net::Z3950::SimpleServer module and passed as the {RPN} argument to
+search handlers.  This emulation is useful for testing code that
+expects to receive queries in that format.
+
+=cut
+
+sub toSimpleServer {
+    my $class = shift();
+    die "can't translate an abstract $class into SimpleServer form";
+}
+
+
+
+# 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 +195,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";
@@ -179,6 +204,43 @@ sub render {
     return $text;
 }
 
+sub toSimpleServer {
+    my $this = shift();
+
+    my $attrs = bless [], "Net::Z3950::RPN::Attributes";
+    foreach my $attr (@{ $this->{attrs} }) {
+	my($set, $type, $val) = @$attr;
+	push @$attrs, bless {
+	    attributeSet => $set,
+	    attributeType => $type,
+	    attributeValue => $val, 
+	}, "Net::Z3950::RPN::Attribute";
+    }
+
+    return bless {
+	$this->_ssname() => $this->{value},
+	attributes => $attrs,
+    }, $this->_ssclass();
+}
+
+
+
+package Net::Z3950::PQF::TermNode;
+our @ISA = qw(Net::Z3950::PQF::LeafNode);
+
+sub _name { "term" }
+sub _ssname { "term" }
+sub _ssclass { "Net::Z3950::RPN::Term" }
+
+
+
+package Net::Z3950::PQF::RsetNode;
+our @ISA = qw(Net::Z3950::PQF::LeafNode);
+
+sub _name { "rset" }
+sub _ssname { "id" }
+sub _ssclass { "Net::Z3950::RPN::RSID" }
+
 
 
 # PRIVATE class, used as base by AndNode, OrNode and NotNode
@@ -207,12 +269,24 @@ sub render {
     return $text;
 }
 
+sub toSimpleServer {
+    my $this = shift();
+
+    my $res;
+    foreach my $sub (@{ $this->{sub} }) {
+	push @$res, $sub->toSimpleServer();
+    }
+
+    return bless $res, $this->_ssclass();
+}
+
 
 
 package Net::Z3950::PQF::AndNode;
 our @ISA = qw(Net::Z3950::PQF::BooleanNode);
 
 sub _op { "and" }
+sub _ssclass { "Net::Z3950::RPN::And" }
 
 
 
@@ -220,6 +294,7 @@ package Net::Z3950::PQF::OrNode;
 our @ISA = qw(Net::Z3950::PQF::BooleanNode);
 
 sub _op { "or" }
+sub _ssclass { "Net::Z3950::RPN::Or" }
 
 
 
@@ -227,6 +302,7 @@ package Net::Z3950::PQF::NotNode;
 our @ISA = qw(Net::Z3950::PQF::BooleanNode);
 
 sub _op { "not" }
+sub _ssclass { "Net::Z3950::RPN::AndNote" }