samples/zoom/zselect

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