Merge branch 'master' of ssh://git.indexdata.com/home/git/pub/irspy
authorMike Taylor <mike@miketaylor.org.uk>
Mon, 12 Apr 2010 13:12:07 +0000 (14:12 +0100)
committerMike Taylor <mike@miketaylor.org.uk>
Mon, 12 Apr 2010 13:12:07 +0000 (14:12 +0100)
lib/ZOOM/IRSpy.pm
lib/ZOOM/IRSpy/Utils.pm
web/htdocs/chrome/layout.mc
web/htdocs/details/edit.mc
web/htdocs/details/found.mc
web/htdocs/details/full.mc
web/htdocs/details/upload.mc

index 13e6321..d330113 100644 (file)
@@ -262,7 +262,9 @@ sub _hash {
 
 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) {
@@ -286,24 +288,24 @@ sub _irspy_to_zeerex {
 }
 
 
-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();
@@ -431,7 +433,7 @@ sub check {
                    }
                    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) {
index 7853d20..9c5f951 100644 (file)
@@ -18,7 +18,8 @@ our @EXPORT_OK = qw(utf8param
                    irspy_identifier2target
                    modify_xml_document
                    bib1_access_point
-                   render_record);
+                   render_record
+                   calc_reliability);
 
 use XML::LibXML;
 use XML::LibXML::XPathContext;
@@ -770,4 +771,16 @@ sub render_record {
 }
 
 
+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;
index b99cb80..1471202 100644 (file)
@@ -12,7 +12,7 @@ use ZOOM::IRSpy::Utils qw(utf8param isodate xml_encode cql_target cql_quote
                           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);
index be35470..e0403a4 100644 (file)
@@ -352,7 +352,7 @@ if ($update && @changedFields) {
                                             "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);
 }
 
index 13143c6..8380171 100644 (file)
@@ -19,22 +19,6 @@ sub navlink {
     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>
@@ -131,7 +115,7 @@ print_navlink(\%params, $last < $n, "Next", $skip+$count);
 <%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");
index abf5c01..4157b1f 100644 (file)
@@ -41,7 +41,7 @@ if ($n == 0) {
                  [ "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" ],
@@ -95,15 +95,9 @@ if ($n == 0) {
 % }
 <%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 {
index 5a5aab3..3809292 100644 (file)
@@ -51,7 +51,7 @@ my $id = irspy_record2identifier($xc);
 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.