-# $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;
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.
}
+=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;
}
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";
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
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" }
our @ISA = qw(Net::Z3950::PQF::BooleanNode);
sub _op { "or" }
+sub _ssclass { "Net::Z3950::RPN::Or" }
our @ISA = qw(Net::Z3950::PQF::BooleanNode);
sub _op { "not" }
+sub _ssclass { "Net::Z3950::RPN::AndNote" }