From: Wolfram Schneider Date: Wed, 14 Apr 2010 11:58:10 +0000 (+0000) Subject: Merge branch 'nigiri' X-Git-Tag: CPAN-v1.02~54^2~93 X-Git-Url: http://git.indexdata.com/?p=irspy-moved-to-github.git;a=commitdiff_plain;h=87eef33eee0a92bf11aa4d4fcc061526f9176a50;hp=-c Merge branch 'nigiri' Conflicts: zebra/README --- 87eef33eee0a92bf11aa4d4fcc061526f9176a50 diff --combined lib/ZOOM/IRSpy.pm index b1d07c7,16625d0..3e93b47 --- a/lib/ZOOM/IRSpy.pm +++ b/lib/ZOOM/IRSpy.pm @@@ -18,12 -18,13 +18,14 @@@ use ZOOM::IRSpy::Connection use ZOOM::IRSpy::Stats; use ZOOM::IRSpy::Utils qw(cql_target render_record irspy_xpath_context irspy_make_identifier - irspy_record2identifier); + irspy_record2identifier calc_reliability_stats + modify_xml_document); our @ISA = qw(); - our $VERSION = '1.01'; + our $VERSION = '1.02'; our $irspy_to_zeerex_xsl = dirname(__FILE__) . '/../../xsl/irspy2zeerex.xsl'; + our $debug = 0; + our $xslt_max_depth = 250; # Enumeration for callback functions to return @@@ -69,6 -70,7 +71,7 @@@ sub new my $class = shift(); my($dbname, $user, $password, $activeSetSize) = @_; + my @options; push @options, (user => $user, password => $password) if defined $user; @@@ -78,10 -80,15 +81,15 @@@ my $xslt = new XML::LibXSLT; + # raise the maximum number of nested template calls and variables/params (default 250) + warn "raise the maximum number of nested template calls: $xslt_max_depth\n" if $debug; + $xslt->max_depth($xslt_max_depth); + $xslt->register_function($ZOOM::IRSpy::Utils::IRSPY_NS, 'strcmp', \&ZOOM::IRSpy::Utils::xslt_strcmp); my $libxml = new XML::LibXML; + warn "use irspy_to_zeerex_xsl xslt sheet: $irspy_to_zeerex_xsl\n" if $debug; my $xsl_doc = $libxml->parse_file($irspy_to_zeerex_xsl); my $irspy_to_zeerex_style = $xslt->parse_stylesheet($xsl_doc); @@@ -263,9 -270,7 +271,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) { @@@ -289,37 -294,26 +297,37 @@@ } -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 { +my $_reliabilityField = { + reliability => [ reliability => 0, + "Calculated reliability of server", + "e:serverInfo/e:reliability" ], +}; + +sub _rewrite_zeerex_record { my($conn, $rec, $oldid) = @_; + # Add reliability score + my $xc = irspy_xpath_context($rec); + my($nok, $nall, $percent) = calc_reliability_stats($xc); + modify_xml_document($xc, $_reliabilityField, { reliability => $percent }); + my $p = $conn->package(); $p->option(action => "specialUpdate"); my $xml = $rec->toString(); @@@ -329,6 -323,7 +337,6 @@@ # This is the expression in the ID-making stylesheet # ../../zebra/zeerex2id.xsl - my $xc = irspy_xpath_context($rec); my $id = irspy_record2identifier($xc); if (defined $oldid && $id ne $oldid) { warn "IDs differ (old='$oldid' new='$id')"; @@@ -444,7 -439,7 +452,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) { diff --combined lib/ZOOM/IRSpy/Utils.pm index dcf33ae,b1d2331..dfe4e99 --- a/lib/ZOOM/IRSpy/Utils.pm +++ b/lib/ZOOM/IRSpy/Utils.pm @@@ -6,6 -6,8 +6,8 @@@ use 5.008 use strict; use warnings; + use Scalar::Util; + use Exporter 'import'; our @EXPORT_OK = qw(utf8param isodate @@@ -18,9 -20,7 +20,9 @@@ irspy_identifier2target modify_xml_document bib1_access_point - render_record); + render_record + calc_reliability_string + calc_reliability_stats); use XML::LibXML; use XML::LibXML::XPathContext; @@@ -262,7 -262,7 +264,7 @@@ sub _irspy_identifier2target if !defined $id; my($protocol, $target) = ($id =~ /(.*?):(.*)/); - if (uc($protocol) eq "Z39.50") { + if (uc($protocol) eq "Z39.50" || uc($protocol) eq "TCP") { return "tcp:$target"; } elsif (uc($protocol) eq "SRU") { return "sru=get,http:$target"; @@@ -275,11 -275,6 +277,11 @@@ } +# Modifies the XML document for which $xc is an XPath context by +# inserting or replacing the values specified in the hash %$data. The +# keys are fieldnames, which are looked up in the register +# $fieldsByKey to determine, among other things, what their XPath is. + sub modify_xml_document { my($xc, $fieldsByKey, $data) = @_; @@@ -777,26 -772,4 +779,26 @@@ sub render_record } +sub calc_reliability_string { + my($xc) = @_; + + my($nok, $nall, $percent) = calc_reliability_stats($xc); + return "[untested]" if $nall == 0; + return "$nok/$nall = " . $percent . "%"; +} + + +sub calc_reliability_stats { + my($xc) = @_; + + my @allpings = $xc->findnodes("i:status/i:probe"); + my $nall = @allpings; + return (0, 0, 0) if $nall == 0; + my @okpings = $xc->findnodes('i:status/i:probe[@ok = "1"]'); + my $nok = @okpings; + my $percent = int(100*$nok/$nall); + return ($nok, $nall, $percent); +} + + 1; diff --combined zebra/README index ad36e4d,77b87b9..2898e93 --- a/zebra/README +++ b/zebra/README @@@ -100,9 -100,15 +100,14 @@@ The database can be interrogated with S To create the database: + $ make newdb + + or: + tar xzf records-2007-04-18.tar.gz zebraidx-2.0 init zebraidx-2.0 update zeerex.xml - #zebraidx-2.0 update records-2010-04-06 + zebraidx-2.0 update record-2010-04-06 zebraidx-2.0 commit + zebrasrv-2.0 -f yazserver.xml -