sub _irspy_to_zeerex {
my $this = shift();
- my($conn, $save_xml) = @_;
+ my($conn) = @_;
+
+ my $save_xml = $ENV{IRSPY_SAVE_XML};
my $irspy_doc = $conn->record()->{zeerex}->ownerDocument;
if ($save_xml) {
}
-sub _rewrite_record {
+sub _rewrite_irspy_record {
my $this = shift();
my($conn) = @_;
$conn->log("irspy", "rewriting XML record");
- my $rec = $this->_irspy_to_zeerex($conn, $ENV{IRSPY_SAVE_XML});
+ my $rec = $this->_irspy_to_zeerex($conn);
# Since IRSpy can run for a long time between writes back to the
# database, it's quite possible for the server to have closed the
# connection as idle. So re-establish it if necessary.
$this->{conn}->connect($conn->option("host"));
- _really_rewrite_record($this->{conn}, $rec);
+ _rewrite_zeerex_record($this->{conn}, $rec);
$conn->log("irspy", "rewrote XML record");
}
-sub _really_rewrite_record {
+sub _rewrite_zeerex_record {
my($conn, $rec, $oldid) = @_;
my $p = $conn->package();
}
if (!defined $nextaddr) {
$conn->log("irspy", "has no more tests: removing");
- $this->_rewrite_record($conn);
+ $this->_rewrite_irspy_record($conn);
$conn->option(rewrote_record => 1);
my $newconn = $this->_next_connection();
if (!defined $newconn) {
irspy_identifier2target
modify_xml_document
bib1_access_point
- render_record);
+ render_record
+ calc_reliability);
use XML::LibXML;
use XML::LibXML::XPathContext;
}
+sub calc_reliability {
+ my($xc) = @_;
+
+ my @allpings = $xc->findnodes("i:status/i:probe");
+ my $nall = @allpings;
+ return "[untested]" if $nall == 0;
+ my @okpings = $xc->findnodes('i:status/i:probe[@ok = "1"]');
+ my $nok = @okpings;
+ return "$nok/$nall = " . int(100*$nok/$nall) . "%";
+}
+
+
1;
irspy_xpath_context irspy_make_identifier
irspy_record2identifier
irspy_identifier2target modify_xml_document
- bib1_access_point);
+ bib1_access_point calc_reliability);
</%once>
% $r->content_type("text/html; charset=utf-8");
% my $text = $m->scomp($component, %ARGS);
"e:metaInfo/e:dateModified" ] },
{ dateModified => isodate(time()) });
die "Didn't set dateModified!" if !@x;
- ZOOM::IRSpy::_really_rewrite_record($conn, $xc->getContextNode(),
+ ZOOM::IRSpy::_rewrite_zeerex_record($conn, $xc->getContextNode(),
$op eq "edit" ? $id : undef);
}
return $url;
}
-# Identical to the same-named function in full.mc
-# So maybe this should go into IRSpy::Utils.pm?
-# Name changed (append 2) to prevent inadvertent clashes in Mason namespace
-#
-sub calc_reliability2 {
- my($xc) = @_;
-
- my @allpings = $xc->findnodes("i:status/i:probe");
- my $nall = @allpings;
- return "[untested]" if $nall == 0;
- my @okpings = $xc->findnodes('i:status/i:probe[@ok = "1"]');
- my $nok = @okpings;
- return "$nok/$nall = " . int(100*$nok/$nall) . "%";
-}
-
-
# Just make this once; forge the connection on first use
our $conn = undef;
</%once>
<%perl>
my $xc = irspy_xpath_context($rs->record($i-1));
my $title = $xc->find("e:databaseInfo/e:title") || "[UNTITLED]";
-my $reliability = calc_reliability2($xc);
+my $reliability = calc_reliability($xc);
my $host = $xc->find("e:serverInfo/e:host");
my $port = $xc->find("e:serverInfo/e:port");
my $db = $xc->find("e:serverInfo/e:database");
[ "Implementation ID" => "i:status/i:implementationId" ],
[ "Implementation Name" => "i:status/i:implementationName" ],
[ "Implementation Version" => "i:status/i:implementationVersion" ],
- [ "Reliability/reliability" => \&calc_reliability, $xc ],
+ [ "Reliability/reliability" => \&calc_reliability_wrapper, $xc ],
[ "Services" => \&calc_init_options, $xc ],
[ "Bib-1 Use attributes" => \&calc_ap, $xc, "bib-1" ],
[ "Dan-1 Use attributes" => \&calc_ap, $xc, "dan-1" ],
% }
<%perl>
-sub calc_reliability {
+sub calc_reliability_wrapper {
my($id, $xc) = @_;
-
- my @allpings = $xc->findnodes("i:status/i:probe");
- my $nall = @allpings;
- return "[untested]" if $nall == 0;
- my @okpings = $xc->findnodes('i:status/i:probe[@ok = "1"]');
- my $nok = @okpings;
- return "$nok/$nall = " . int(100*$nok/$nall) . "%";
+ return calc_reliability($xc);
}
sub calc_init_options {
my $conn = new ZOOM::Connection("localhost:8018/IR-Explain---1", 0,
user => "admin", password => "fruitbat",
elementSetName => "zeerex");
-ZOOM::IRSpy::_really_rewrite_record($conn, $xc->getContextNode());
+ZOOM::IRSpy::_rewrite_zeerex_record($conn, $xc->getContextNode());
</%perl>
<p>
Upload OK.