The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
#
# 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'

use XML::LibXML;
use ZOOM;
use strict;
use warnings;

die "Usage: $0 <database> <displayXPath> <deleteXPath>\n" if @ARGV != 3;
my($dbname, $displayXPath, $deleteXPath) = @ARGV;

my $libxml = new XML::LibXML;
my $conn = new ZOOM::Connection($dbname);
my $rs = $conn->search(new ZOOM::Query::CQL("cql.allRecords=1"));
$rs->option(elementSetName => "zeerex");

my $n = $rs->size();
foreach my $i (1 .. $n) {
    my $xml = $rs->record($i-1)->render();
    my $rec = $libxml->parse_string($xml)->documentElement();
    my $xc = XML::LibXML::XPathContext->new($rec);
    $xc->registerNs(zeerex => "http://explain.z3950.org/dtd/2.0/");
    $xc->registerNs(irspy => "http://indexdata.com/irspy/1.0");
    my $val = $xc->findvalue($displayXPath);
    print "Record $i/$n: $val";
    $val = $xc->findvalue($deleteXPath);
    if ($val eq "true") {
	my $id = ZOOM_record_id($rs, $i);
	print " DELETE $id";
	my $p = $conn->package();
	$p->option(action => "recordDelete");
	$p->option(record => $xml);
	$p->send("update");
	$p->destroy();
    }
    print "\n";
}

my $p = $conn->package();
$p->send("commit");
$p->destroy();

sub ZOOM_record_id {
    my($rs, $i) = @_;
    # There is no standard way in Z39.50 to discover the opaque record
    # ID of a given record, which is a bit silly as you need this in
    # order to update or delete it using Extended Services.  So we
    # adopt the convention that fetching the record with element-set
    # "id" returns the ID.  This convention is implemented by the
    # IRSpy database, among others.

    my $old = $rs->option(elementSetName => "id");
    my $id = $rs->record($i-1)->render();    
    $rs->option(elementSetName => $old);
    return $id;
}