X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=SimpleServer.pm;h=c3963fe68bb754f02e5bb8bf17ad6f23d2e8c696;hb=60a0c4dbeddc69d23c1c8a2ab552dae2f96cb952;hp=f59b2848c77312298f1e24150e2117f93e267fe8;hpb=7ad55153498534c6642e86e0aa987b291c6107bb;p=simpleserver-moved-to-github.git

diff --git a/SimpleServer.pm b/SimpleServer.pm
index f59b284..c3963fe 100644
--- a/SimpleServer.pm
+++ b/SimpleServer.pm
@@ -25,7 +25,7 @@
 ##
 ##
 
-## $Id: SimpleServer.pm,v 1.37 2007-08-17 16:45:45 mike Exp $
+## $Id: SimpleServer.pm,v 1.41 2007-08-20 15:34:29 mike Exp $
 
 package Net::Z3950::SimpleServer;
 
@@ -96,22 +96,69 @@ sub launch_server {
 	if (defined($self->{EXPLAIN})) {
 		set_explain_handler($self->{EXPLAIN});
 	}
+	if (defined($self->{DELETE})) {
+		set_delete_handler($self->{DELETE});
+	}
 
 	start_server(@args);
 }
 
 
 # Register packages that we will use in translated RPNs
+package Net::Z3950::RPN::Node;
 package Net::Z3950::APDU::Query;
+our @ISA = qw(Net::Z3950::RPN::Node);
 package Net::Z3950::APDU::OID;
 package Net::Z3950::RPN::And;
+our @ISA = qw(Net::Z3950::RPN::Node);
 package Net::Z3950::RPN::Or;
+our @ISA = qw(Net::Z3950::RPN::Node);
 package Net::Z3950::RPN::AndNot;
+our @ISA = qw(Net::Z3950::RPN::Node);
 package Net::Z3950::RPN::Term;
+our @ISA = qw(Net::Z3950::RPN::Node);
 package Net::Z3950::RPN::RSID;
+our @ISA = qw(Net::Z3950::RPN::Node);
 package Net::Z3950::RPN::Attributes;
 package Net::Z3950::RPN::Attribute;
 
+
+# Utility method for re-rendering Type-1 query back down to PQF
+package Net::Z3950::RPN::Node;
+
+sub toPQF {
+    my $this = shift();
+    my $class = ref $this;
+
+    if ($class eq "Net::Z3950::APDU::Query") {
+	my $res = "";
+	my $set = $this->{attributeSet};
+	$res .= "\@attrset $set " if defined $set;
+	return $res . $this->{query}->toPQF();
+    } elsif ($class eq "Net::Z3950::RPN::Or") {
+	return '@or ' . $this->[0]->toPQF() . ' ' . $this->[1]->toPQF();
+    } elsif ($class eq "Net::Z3950::RPN::And") {
+	return '@and ' . $this->[0]->toPQF() . ' ' . $this->[1]->toPQF();
+    } elsif ($class eq "Net::Z3950::RPN::AndNot") {
+	return '@not ' . $this->[0]->toPQF() . ' ' . $this->[1]->toPQF();
+    } elsif ($class eq "Net::Z3950::RPN::RSID") {
+	return '@set ' . $this->{id};
+    } elsif ($class ne "Net::Z3950::RPN::Term") {
+	die "unknown PQF node-type '$class'";
+    }
+
+    my $res = "";
+    foreach my $attr (@{ $this->{attributes} }) {
+	$res .= "\@attr ";
+	my $set = $attr->{attributeSet};
+	$res .= "$set " if defined $set;
+	$res .= $attr->{attributeType} . "=" . $attr->{attributeValue} . " ";
+    }
+
+    return $res . $this->{term};
+}
+
+
 # Must revert to original package for Autoloader's benefit
 package Net::Z3950::SimpleServer;
 
@@ -222,7 +269,8 @@ means of the SimpleServer object constructor
 			PRESENT	=>	\&my_present_handler,
 			SCAN	=>	\&my_scan_handler,
 			FETCH	=>	\&my_fetch_handler,
-  			EXPLAIN =>	\&my_explain_handler);
+  			EXPLAIN =>	\&my_explain_handler,
+  			DELETE =>	\&my_delete_handler);
 
 In addition, the arguments to the constructor may include GHANDLE, a
 global handle which is made available to each invocation of every
@@ -418,9 +466,6 @@ of the result-set is in the C<id> element.
 
 =back
 
-(I guess I should make a superclass C<Net::Z3950::RPN::Node> and make
-all of these subclasses of it.  Not done that yet, but will do one day.)
-
 =back
 
 =over 4
@@ -469,7 +514,7 @@ a ``relation'' attribute, etc.
 
 =item C<attributeValue>
 
-An integer indicating the value of the attribute - for example, under
+An integer or string indicating the value of the attribute - for example, under
 BIB-1, if the attribute type is 1, then value 4 indictates a title
 search and 7 indictates an ISBN search; but if the attribute type is
 2, then value 4 indicates a ``greater than or equal'' search, and 102
@@ -479,7 +524,12 @@ indicates a relevance match.
 
 =back
 
-Note that, at the moment, none of these classes have any methods at
+All of these classes except C<Attributes> and C<Attribute> are
+subclasses of the abstract class C<Net::Z3950::RPN::Node>.  That class
+has a single method, C<toPQF()>, which may be used to turn an RPN
+tree, or part of one, back into a textual prefix query.
+
+Note that, apart to C<toPQF()>, none of these classes have any methods at
 all: the blessing into classes is largely just a documentation thing
 so that, for example, if you do
 
@@ -667,6 +717,30 @@ What ever data structure the HANDLE value points at goes out of scope
 after this call. If you need to close down a connection to your server
 or something similar, this is the place to do it.
 
+=head2 Delete handler
+
+The argument hash recieved by the delete handler has the following elements:
+
+  $args = {
+				    ## Client request:
+	     GHANDLE   =>  $obj,    ## Global handler specified at creation
+	     HANDLE    =>  ref,     ## Reference to data structure
+	     SETNAME   =>  "id",    ## Result set ID
+
+				    ## Server response:
+	     STATUS    => 0         ## Deletion status
+	  };
+
+The SETNAME element of the argument hash may or may not be defined.
+If it is, then SETNAME is the name of a result set to be deleted; if
+not, then all result-sets associated with the current session should
+be deleted.  In either case, the callback function should report on
+success or failure by setting the STATUS element either to zero, on
+success, or to an integer from 1 to 10, to indicate one of the ten
+possible failure codes described in section 3.2.4.1.4 of the Z39.50
+standard -- see 
+http://www.loc.gov/z3950/agency/markup/05.html#Delete-list-statuses1
+
 =head2 Support for SRU and SRW
 
 Since release 1.0, SimpleServer includes support for serving the SRU