-# $Id: IRSpy.pm,v 1.69 2007-02-26 14:49:23 mike Exp $
+# $Id: IRSpy.pm,v 1.73 2007-03-01 14:00:50 mike Exp $
package ZOOM::IRSpy;
my $this = bless {
conn => $conn,
- allrecords => 1, # unless overridden by targets()
- query => undef, # filled in later
+ query => "cql.allRecords=1", # unless overridden
targets => undef, # filled in later
connections => undef, # filled in later
libxml => $libxml,
}
+sub find_targets {
+ my $this = shift();
+ my($query) = @_;
+
+ $this->{query} = $query;
+}
+
+
# Explicitly nominate a set of targets to check, overriding the
# default which is to re-check everything in the database. Each
# target already in the database results in the existing record being
$this->log("irspy", "setting explicit list of targets ",
join(", ", map { "'$_'" } @targets));
- $this->{allrecords} = 0;
my @qlist;
foreach my $target (@targets) {
my($host, $port, $db, $newtarget) = _parse_target_string($target);
}
-sub find_targets {
- my $this = shift();
- my($query) = @_;
-
- $this->{allrecords} = 0;
- $this->{query} = $query;
-}
-
-
# Also used by ZOOM::IRSpy::Record
sub _parse_target_string {
my($target) = @_;
}
-# There are two cases.
-#
-# 1. A specific set of targets is nominated on the command line.
-# - Records must be fetched for those targets that are in the DB
-# - New, empty records must be made for those that are not.
-# - Updated records written to the DB may or may not be new.
-#
-# 2. All records in the database are to be checked.
-# - Records must be fetched for all targets in the DB
-# - Updated records written to the DB may not be new.
-#
-# That's all -- what could be simpler?
+# Records must be fetched for all records satisfying $this->{query} If
+# $this->{targets} is already set (i.e. a specific list of targets to
+# check was specified by a call to targets()), then new, empty records
+# must be made for any targets that are not already in the database.
#
sub initialise {
my $this = shift();
my %target2record;
- if ($this->{allrecords}) {
- # We need to check on every target in the database, which
- # means we need to do a "find all". According to the BIB-1
- # semantics document at
- # http://www.loc.gov/z3950/agency/bib1.html
- # the query
- # @attr 2=103 @attr 1=1035 x
- # should find all records, but it seems that Zebra doesn't
- # support this. Furthermore, when using the "alvis" filter
- # (as we do for IRSpy) it doesn't support the use of any BIB-1
- # access point -- not even 1035 "everywhere" -- so instead we
- # hack together a search that we know will find all records.
- $this->{query} = "port=?*";
- } elsif ($this->{targets}) {
+ if ($this->{targets}) {
# Prepopulate the target map with nulls so that after we fill
# in what we can from the database query, we know which target
# IDs we need new records for.
$target2record{lc($target)} = undef;
}
}
+ delete $this->{targets}; # Information now in keys of %target2record
- $this->log("irspy_debug", "query '", $this->{query}, "'");
my $rs = $this->{conn}->search(new ZOOM::Query::CQL($this->{query}));
- delete $this->{query}; # No longer needed at all
- $this->log("irspy_debug", "found ", $rs->size(), " target records");
- my $gatherTargets = !$this->{targets};
+ $this->log("irspy", "'", $this->{query}, "' found ",
+ $rs->size(), " target records");
+ delete $this->{query}; # Information now in $rs
+
foreach my $i (1 .. $rs->size()) {
my $target = _render_record($rs, $i-1, "id");
my $zeerex = _render_record($rs, $i-1, "zeerex");
- #print STDERR "making '$target' record with '$zeerex'\n";
$target2record{lc($target)} =
new ZOOM::IRSpy::Record($this, $target, $zeerex);
- push @{ $this->{targets} }, $target
- if $gatherTargets;
}
# Make records for targets not previously in the database
foreach my $target (keys %target2record) {
- my $record = $target2record{$target};
- if (!defined $record) {
- $this->log("irspy_debug", "made new record for '$target'");
+ if (!defined $target2record{$target}) {
$target2record{$target} = new ZOOM::IRSpy::Record($this, $target);
+ $this->log("irspy_debug", "made new record for '$target'");
} else {
$this->log("irspy_debug", "using existing record for '$target'");
}
}
my @connections;
- foreach my $target (@{ $this->{targets} }) {
+ my @targets = sort keys %target2record;
+ foreach my $target (@targets) {
my $conn = create ZOOM::IRSpy::Connection($this, async => 1);
$conn->option(host => $target);
my $record = delete $target2record{lc($target)};
+ die "record undefined for '$target'" if !defined $record;
$conn->record($record);
push @connections, $conn;
}
if %target2record;
$this->{connections} = \@connections;
- delete $this->{targets}; # The information is now in {connections}
}
if ($save_xml) {
unlink('/tmp/irspy_orig.xml');
- open FH, '>/tmp/irspy_orig.xml';
+ open FH, '>/tmp/irspy_orig.xml'
+ or die "can't write irspy_orig.xml: $!";
print FH $irspy_doc->toString();
close FH;
}
my $result = $this->{irspy_to_zeerex_style}->transform($irspy_doc, %params);
if ($save_xml) {
unlink('/tmp/irspy_transformed.xml');
- open FH, '>/tmp/irspy_transformed.xml';
+ open FH, '>/tmp/irspy_transformed.xml'
+ or die "can't write irspy_transformed.xml: $!";
print FH $result->toString();
close FH;
}
$tname = "Main" if !defined $tname;
$this->{tree} = $this->_gather_tests($tname)
or die "No tests defined for '$tname'";
+ $this->{tree}->resolve();
#$this->{tree}->print(0);
my $nskipped = 0;
$conn->next_task(0);
if ($res == ZOOM::IRSpy::Status::TEST_BAD) {
my $address = $conn->option('current_test_address');
- ($address, my $n) = $this->_last_sibling_test($address);
- if (defined $address) {
- $conn->log("irspy_test", "skipped $n tests");
- $conn->option(current_test_address => $address);
- $nskipped += $n;
+ $conn->log("irspy", "top-level test failed!")
+ if $address eq "";
+ my $node = $this->{tree}->select($address);
+ my $skipcount = 0;
+ while (defined $node->next() &&
+ length($node->next()->address()) >= length($address)) {
+ $conn->log("irspy_debug", "skipping from '",
+ $node->address(), "' to '",
+ $node->next()->address(), "'");
+ $node = $node->next();
+ $skipcount++;
}
+
+ $conn->option(current_test_address => $node->address());
+ $conn->log("irspy_test", "skipped $skipcount tests");
+ $nskipped += $skipcount;
}
} elsif ($res == ZOOM::IRSpy::Status::TEST_SKIPPED) {
projects / irspy-moved-to-github.git / blobdiff