use XML::LibXML::XPathContext;
use ZOOM;
use Net::Z3950::ZOOM 1.13; # For the ZOOM version-check only
use ZOOM::IRSpy::Node;
use ZOOM::IRSpy::Connection;
use ZOOM::IRSpy::Record;
use XML::LibXML::XPathContext;
use ZOOM;
use Net::Z3950::ZOOM 1.13; # For the ZOOM version-check only
use ZOOM::IRSpy::Node;
use ZOOM::IRSpy::Connection;
use ZOOM::IRSpy::Record;
my $conn = new ZOOM::Connection($dbname, 0, @options)
or die "$0: can't connection to IRSpy database 'dbname'";
my $conn = new ZOOM::Connection($dbname, 0, @options)
or die "$0: can't connection to IRSpy database 'dbname'";
my $this = bless {
conn => $conn,
allrecords => 1, # unless overridden by targets()
query => undef, # filled in later
targets => undef, # filled in later
connections => undef, # filled in later
my $this = bless {
conn => $conn,
allrecords => 1, # unless overridden by targets()
query => undef, # filled in later
targets => undef, # filled in later
connections => undef, # filled in later
tests => [], # stack of tests currently being executed
}, $class;
$this->log("irspy", "starting up with database '$dbname'");
tests => [], # stack of tests currently being executed
}, $class;
$this->log("irspy", "starting up with database '$dbname'");
+sub _irspy_to_zeerex {
+ my ($this, $conn) = @_;
+ my $irspy_doc = $conn->record()->{zeerex}->ownerDocument;
+ my %params = ();
+ my $result = $this->{irspy_to_zeerex_style}->transform($irspy_doc, %params);
+
+ return $result->documentElement();
+}
+
+
- my $rec = $conn->record();
- my $p = $this->{conn}->package();
+ my $rec = $this->_irspy_to_zeerex($conn);
+ _really_rewrite_record($this->{conn}, $rec);
+}
+
+
+sub _really_rewrite_record {
+ my($conn, $rec) = @_;
+
+ my $p = $conn->package();
join(" -> ", @ancestors, $tname))
if grep { $_ eq $tname } @ancestors;
join(" -> ", @ancestors, $tname))
if grep { $_ eq $tname } @ancestors;
- my $slashSeperatedTname = $tname;
- $slashSeperatedTname =~ s/::/\//g;
- require "ZOOM/IRSpy/Test/$slashSeperatedTname.pm";
+ require $fullName;
+ $this->log("irspy", "successfully required '$fullName'");
$this->log("warn", "can't load test '$tname': skipping",
$@ =~ /^Can.t locate/ ? () : " ($@)");
return undef;
$this->log("warn", "can't load test '$tname': skipping",
$@ =~ /^Can.t locate/ ? () : " ($@)");
return undef;
my $root = $doc->getDocumentElement();
my $xc = XML::LibXML::XPathContext->new($root);
$xc->registerNs(e => 'http://explain.z3950.org/dtd/2.0/');
my $root = $doc->getDocumentElement();
my $xc = XML::LibXML::XPathContext->new($root);
$xc->registerNs(e => 'http://explain.z3950.org/dtd/2.0/');