samples/zoom/zselect

   1 #!/usr/bin/perl -w
   2
   3 # $Id: zselect,v 1.1 2006-09-25 11:43:21 mike Exp $
   4
   5 use strict;
   6 use warnings;
   7 use Getopt::Std;
   8 use ZOOM;
   9 use XML::LibXML;
  10 use XML::LibXML::XPathContext;
  11
  12 my %opts = (t => "p");
  13 if (!getopts('t:', \%opts) || @ARGV != 3) {
  14     print STDERR "Usage: $0 [-t queryType] <target> <query> <xpath>
  15 Query types:
  16         p       Query is in prefix query format (PQF) [default]
  17         c       Query is in CCL, sent directly to server
  18         q       Query is in CQL, sent directly to server
  19         C       Query is in CCL, translated on client side
  20         Q       Query is in CQL, translated on client side
  21 ";
  22     exit 1;
  23 }
  24
  25 my($target, $qstring, $xpath) = @ARGV;
  26 my $type = $opts{t};
  27 my %type2class = (
  28                   p => "PQF",
  29                   c => "CCL",   # Bizarrely, not yet implemented in ZOOM
  30                   q => "CQL",
  31                   C => "CCL2RPN",
  32                   Q => "CQL2RPN",
  33                   );
  34 my $class = $type2class{$type};
  35 if (!defined $class) {
  36     print STDERR "$0: unrecognised query type '$type'\n";
  37     exit 2;
  38 }
  39
  40 my $conn = new ZOOM::Connection($target);
  41 my $query = "ZOOM::Query::$class"->new($qstring, $conn);
  42 $conn->option(presentChunk => 50);
  43 my $rs = $conn->search($query);
  44 my $n = $rs->size();
  45 #print "found $n record", ($n==1 ? "" : "s"), "\n";
  46
  47 $rs->option(preferredRecordSyntax => "xml");
  48 $conn->option(elementSetName => "zeerex");
  49 my $parser = new XML::LibXML();
  50
  51 foreach my $i (1..$n) {
  52     my $rec = $rs->record($i-1);
  53     my $xml = $rec->render();
  54     my $doc = $parser->parse_string($xml);
  55     my $root = $doc->getDocumentElement();
  56     my $xc = XML::LibXML::XPathContext->new($root);
  57     register_namespaces($xc);
  58     print $xc->find($xpath), "\n";
  59 }
  60
  61
  62 # I feel really bad about having to have a hardwired list of supported
  63 # namespaces, but since it's entirely the fault of LibXML's retarded
  64 # lack of proper namespace support in its XPath handling, I am not
  65 # going to let it spoil my day.
  66 #
  67 sub register_namespaces {
  68     my($xc) = @_;
  69     $xc->registerNs(zeerex => 'http://explain.z3950.org/dtd/2.0/');
  70     # More to come
  71 }