samples/zoom/zoom-delete-records

   1 #!/usr/bin/perl
   2 #
   3 # zoom-delete-records user=admin,password=fruitbat,localhost:8018/IR-Explain---1 'concat(count(irspy:status/irspy:probe[@ok=1]), "/", count(irspy:status/irspy:probe))' 'count(irspy:status/irspy:probe[@ok=1]) = 0 and count(irspy:status/irspy:probe) >= 10'
   4
   5 use XML::LibXML;
   6 use ZOOM;
   7 use strict;
   8 use warnings;
   9
  10 die "Usage: $0 <database> <displayXPath> <deleteXPath>\n" if @ARGV != 3;
  11 my($dbname, $displayXPath, $deleteXPath) = @ARGV;
  12
  13 my $libxml = new XML::LibXML;
  14 my $conn = new ZOOM::Connection($dbname);
  15 my $rs = $conn->search(new ZOOM::Query::CQL("cql.allRecords=1"));
  16 $rs->option(elementSetName => "zeerex");
  17
  18 my $n = $rs->size();
  19 foreach my $i (1 .. $n) {
  20     my $xml = $rs->record($i-1)->render();
  21     my $rec = $libxml->parse_string($xml)->documentElement();
  22     my $xc = XML::LibXML::XPathContext->new($rec);
  23     $xc->registerNs(zeerex => "http://explain.z3950.org/dtd/2.0/");
  24     $xc->registerNs(irspy => "http://indexdata.com/irspy/1.0");
  25     my $val = $xc->findvalue($displayXPath);
  26     print "Record $i/$n: $val";
  27     $val = $xc->findvalue($deleteXPath);
  28     if ($val eq "true") {
  29         my $id = ZOOM_record_id($rs, $i);
  30         print " DELETE $id";
  31         #my $p = $conn->package();
  32         #$p->option(action => "deleteRecord");
  33         #$p->option(recordIdOpaque => $id);
  34         #$p->send("update");
  35         #$p->destroy();
  36     }
  37     print "\n";
  38 }
  39
  40 sub ZOOM_record_id {
  41     my($rs, $i) = @_;
  42     # There is no standard way in Z39.50 to discover the opaque record
  43     # ID of a given record, which is a bit silly as you need this in
  44     # order to update or delete it using Extended Services.  So we
  45     # adopt the convention that fetching the record with element-set
  46     # "id" returns the ID.  This convention is implemented by the
  47     # IRSpy database, among others.
  48
  49     my $old = $rs->option(elementSetName => "id");
  50     my $id = $rs->record($i-1)->render();
  51     $rs->option(elementSetName => $old);
  52     return $id;
  53 }