From d8931f76879e7d7b5d0cb8340291b7d2dac65c91 Mon Sep 17 00:00:00 2001 From: Mike Taylor Date: Fri, 27 Apr 2007 14:04:40 +0000 Subject: [PATCH] Abstract out identifier format, which is now handled by a set of functions in Utils.pm that are used in many places. Clarify distinction between identifier string and target string, which are similar but no longer identical. Identifier string now includes protocol. All of this is to prepare the way for supporting SRU and SRW tests as well as Z39.50 --- lib/ZOOM/IRSpy.pm | 26 +++++++++------- lib/ZOOM/IRSpy/Connection.pm | 9 +++--- lib/ZOOM/IRSpy/Record.pm | 9 +++--- lib/ZOOM/IRSpy/Utils.pm | 71 +++++++++++++++++++++++++++++++++++++++--- web/htdocs/chrome/layout.mc | 22 ++++++------- web/htdocs/details/edit.mc | 15 ++++++--- web/htdocs/details/found.mc | 6 ++-- web/htdocs/details/full.mc | 4 +-- zebra/zeerex2dc.xsl | 5 +-- zebra/zeerex2id.xsl | 5 +-- zebra/zeerex2index.xsl | 3 +- 11 files changed, 124 insertions(+), 51 deletions(-) diff --git a/lib/ZOOM/IRSpy.pm b/lib/ZOOM/IRSpy.pm index 8781f84..aa83513 100644 --- a/lib/ZOOM/IRSpy.pm +++ b/lib/ZOOM/IRSpy.pm @@ -1,4 +1,4 @@ -# $Id: IRSpy.pm,v 1.82 2007-04-18 15:35:51 mike Exp $ +# $Id: IRSpy.pm,v 1.83 2007-04-27 14:04:40 mike Exp $ package ZOOM::IRSpy; @@ -16,7 +16,9 @@ use Net::Z3950::ZOOM 1.13; # For the ZOOM version-check only use ZOOM::IRSpy::Node; use ZOOM::IRSpy::Connection; use ZOOM::IRSpy::Stats; -use ZOOM::IRSpy::Utils qw(cql_target render_record irspy_xpath_context); +use ZOOM::IRSpy::Utils qw(cql_target render_record + irspy_xpath_context irspy_make_identifier + irspy_record2identifier); our @ISA = qw(); our $VERSION = '0.02'; @@ -130,12 +132,13 @@ sub targets { join(", ", map { "'$_'" } @targets)); my @qlist; foreach my $target (@targets) { - my($host, $port, $db, $newtarget) = _parse_target_string($target); + my($protocol, $host, $port, $db, $newtarget) = + _parse_target_string($target); if ($newtarget ne $target) { $this->log("irspy_debug", "rewriting '$target' to '$newtarget'"); $target = $newtarget; # This is written through the ref } - push @qlist, cql_target($host, $port, $db); + push @qlist, cql_target($protocol, $host, $port, $db); } $this->{targets} = \@targets; @@ -147,16 +150,16 @@ sub targets { sub _parse_target_string { my($target) = @_; - my($host, $port, $db) = ($target =~ /(.*?):(.*?)\/(.*)/); + my($protocol, $host, $port, $db) = ($target =~ /(.*?):(.*?):(.*?)\/(.*)/); if (!defined $host) { $port = 210; - ($host, $db) = ($target =~ /(.*?)\/(.*)/); - $target = "$host:$port/$db"; + ($protocol, $host, $db) = ($target =~ /(.*?):(.*?)\/(.*)/); + $target = irspy_make_identifier($protocol, $host, $port, $db); } die "$0: invalid target string '$target'" if !defined $host; - return ($host, $port, $db, $target); + return ($protocol, $host, $port, $db, $target); } @@ -266,12 +269,11 @@ sub _really_rewrite_record { # This is the expression in the ID-making stylesheet # ../../zebra/zeerex2id.xsl my $xc = irspy_xpath_context($rec); - my $id = $xc->find("concat(e:serverInfo/e:host, ':', - e:serverInfo/e:port, '/', - e:serverInfo/e:database)"); + my $id = irspy_record2identifier($xc); if (defined $oldid && $id ne $oldid) { - # Delete old record; warn "IDs differ (old='$oldid' new='$id')"; + # Delete old record; + ### Should use same mechanism as delete.mc my $p = $conn->package(); $p->option(action => "recordDelete"); $p->option(recordIdOpaque => $oldid); diff --git a/lib/ZOOM/IRSpy/Connection.pm b/lib/ZOOM/IRSpy/Connection.pm index 7a90cc9..bd44b12 100644 --- a/lib/ZOOM/IRSpy/Connection.pm +++ b/lib/ZOOM/IRSpy/Connection.pm @@ -1,4 +1,4 @@ -# $Id: Connection.pm,v 1.11 2007-03-15 11:37:30 mike Exp $ +# $Id: Connection.pm,v 1.12 2007-04-27 14:04:40 mike Exp $ package ZOOM::IRSpy::Connection; @@ -10,7 +10,7 @@ use ZOOM; our @ISA = qw(ZOOM::Connection); use ZOOM::IRSpy::Record; -use ZOOM::IRSpy::Utils qw(cql_target render_record); +use ZOOM::IRSpy::Utils qw(cql_target render_record irspy_identifier2target); use ZOOM::IRSpy::Task::Connect; use ZOOM::IRSpy::Task::Search; @@ -41,7 +41,7 @@ sub create { my $target = shift(); my $this = $class->SUPER::create(@_); - $this->option(host => $target); + $this->option(host => irspy_identifier2target($target)); $this->{irspy} = $irspy; $this->{tasks} = []; @@ -51,7 +51,8 @@ sub create { $this->log("irspy", "query '$query' found $n records"); my $zeerex; $zeerex = render_record($rs, 0, "zeerex") if $n > 0; - $this->{record} = new ZOOM::IRSpy::Record($this, $target, $zeerex); + $this->{record} = new ZOOM::IRSpy::Record($this, + irspy_identifier2target($target), $zeerex); return $this; } diff --git a/lib/ZOOM/IRSpy/Record.pm b/lib/ZOOM/IRSpy/Record.pm index a630356..7659e4a 100644 --- a/lib/ZOOM/IRSpy/Record.pm +++ b/lib/ZOOM/IRSpy/Record.pm @@ -1,4 +1,4 @@ -# $Id: Record.pm,v 1.23 2007-03-05 19:42:13 mike Exp $ +# $Id: Record.pm,v 1.24 2007-04-27 14:04:40 mike Exp $ package ZOOM::IRSpy::Record; ### I don't think there's any reason for this to be separate from @@ -48,15 +48,16 @@ sub new { sub _empty_zeerex_record { my($target) = @_; - ### Doesn't recognise SRU/SRW URLs - my($host, $port, $db) = ZOOM::IRSpy::_parse_target_string($target); + my($protocol, $host, $port, $db) = + ZOOM::IRSpy::_parse_target_string($target); + my $xprotocol = xml_encode($protocol); my $xhost = xml_encode($host); my $xport = xml_encode($port); my $xdb = xml_encode($db); return <<__EOT__; - + $xhost $xport $xdb diff --git a/lib/ZOOM/IRSpy/Utils.pm b/lib/ZOOM/IRSpy/Utils.pm index 5db0e33..e24fd6c 100644 --- a/lib/ZOOM/IRSpy/Utils.pm +++ b/lib/ZOOM/IRSpy/Utils.pm @@ -1,4 +1,4 @@ -# $Id: Utils.pm,v 1.26 2007-03-19 18:51:03 mike Exp $ +# $Id: Utils.pm,v 1.27 2007-04-27 14:04:40 mike Exp $ package ZOOM::IRSpy::Utils; @@ -12,6 +12,9 @@ our @EXPORT_OK = qw(isodate cql_quote cql_target irspy_xpath_context + irspy_make_identifier + irspy_record2identifier + irspy_identifier2target modify_xml_document bib1_access_point render_record); @@ -76,10 +79,16 @@ sub cql_quote { # Makes a CQL query that finds a specified target. Arguments may be # either an ID alone, or a (host, port, db) triple. sub cql_target { - my($host, $port, $db) = @_; + my($protocol, $host, $port, $db) = @_; - $host .= ":$port/$db" if defined $port; - return "rec.id=" . cql_quote($host); + my $id; + if (defined $host) { + $id = irspy_make_identifier($protocol, $host, $port, $db); + } else { + $id = $protocol; + } + + return "rec.id=" . cql_quote($id); } @@ -127,6 +136,60 @@ sub irspy_xpath_context { } +# Construct an opaque identifier from its components. Although it's +# trivial, this is needed in so many places that it really needs to be +# factored out. +# +# This is the converse of _parse_target_string() in IRSpy.pm, which +# should be renamed and moved into this package. +# +sub irspy_make_identifier { + my($protocol, $host, $port, $dbname) = @_; + + die "irspy_make_identifier(" . join(", ", map { "'$_'" } @_). + "): wrong number of arguments" if @_ != 4; + + die "irspy_make_identifier(): protocol undefined" if !defined $protocol; + die "irspy_make_identifier(): host undefined" if !defined $host; + die "irspy_make_identifier(): port undefined" if !defined $port; + die "irspy_make_identifier(): dbname undefined" if !defined $dbname; + + return "$protocol:$host:$port/$dbname"; +} + + +# Returns the opaque identifier of an IRSpy record based on the +# XPathContext'ed DOM object, as returned by irspy_xpath_context(). +# This is doing the same thing as irspy_make_identifier() but from a +# record rather than a set of parameters. +# +sub irspy_record2identifier { + my($xc) = @_; + + ### Must be kept the same as is used in ../../../zebra/*.xsl + return $xc->find("concat(e:serverInfo/\@protocol, ':', + e:serverInfo/e:host, ':', + e:serverInfo/e:port, '/', + e:serverInfo/e:database)"); +} + + +# Transforms an IRSpy opqaue identifier, as returned from +# irspy_make_identifier() or irspy_record2identifier(), into a YAZ +# target-string suitable for feeding to ZOOM. Before we introduced +# the protocol element at the start of the identifier string, this was +# a null transform; now we have to be a bit cleverer. +# +sub irspy_identifier2target { + my($id) = @_; + + my($protocol, $target) = ($id =~ /(.*?):(.*)/); + print STDERR "protocol='$protocol', target='$target'\n"; + ### This assumes everything is Z39.50 + return $target; +} + + sub modify_xml_document { my($xc, $fieldsByKey, $data) = @_; diff --git a/web/htdocs/chrome/layout.mc b/web/htdocs/chrome/layout.mc index beef6ac..1ec34b3 100644 --- a/web/htdocs/chrome/layout.mc +++ b/web/htdocs/chrome/layout.mc @@ -1,4 +1,4 @@ -%# $Id: layout.mc,v 1.29 2007-04-26 14:38:37 mike Exp $ +%# $Id: layout.mc,v 1.30 2007-04-27 14:04:40 mike Exp $ <%args> $debug => undef $title @@ -9,7 +9,9 @@ use URI::Escape qw(uri_escape uri_escape_utf8); use ZOOM; use ZOOM::IRSpy::Web; use ZOOM::IRSpy::Utils qw(isodate xml_encode cql_target cql_quote - irspy_xpath_context modify_xml_document + irspy_xpath_context irspy_make_identifier + irspy_record2identifier + irspy_identifier2target modify_xml_document bib1_access_point); % $r->content_type("text/html; charset=utf-8"); @@ -72,24 +74,22 @@ use ZOOM::IRSpy::Utils qw(isodate xml_encode cql_target cql_quote % foreach my $i ('a' .. 'z') { <% uc($i) %> % } - [Others] + [Others]

<%perl> my $id = $r->param("id"); { - # Make up ID for newly created records. It would be more - # rigorously correct, but insanely inefficient, to submit the - # record to Zebra and then search for it; but since we know the - # formula for IDs anyway, we just build one by hand. - my $id = $r->param("id"); + # Make up ID for newly created records. + my $protocol = $r->param("protocol"); my $host = $r->param("host"); my $port = $r->param("port"); my $dbname = $r->param("dbname"); - #warn "id='$id', host='$host', port='$port', dbname='$dbname'"; + #warn "id='$id', protocol='$protocol' host='$host', port='$port', dbname='$dbname'"; #warn "%ARGS = {\n" . join("", map { "\t'$_' => '" . $ARGS{$_} . ",'\n" } sort keys %ARGS) . "}\n"; if ((!defined $id || $id eq "") && - defined $host && defined $port && defined $dbname) { - $id = "$host:$port/$dbname"; + defined $protocol && defined $host && + defined $port && defined $dbname) { + $id = irspy_make_identifier($protocol, $host, $port, $dbname); #warn "id set to '$id'"; } } diff --git a/web/htdocs/details/edit.mc b/web/htdocs/details/edit.mc index ca1213a..4b0b540 100644 --- a/web/htdocs/details/edit.mc +++ b/web/htdocs/details/edit.mc @@ -1,4 +1,4 @@ -%# $Id: edit.mc,v 1.29 2007-03-29 16:19:39 mike Exp $ +%# $Id: edit.mc,v 1.30 2007-04-27 14:04:40 mike Exp $ <%args> $op $id => undef @@ -50,20 +50,25 @@ if (defined $id && ($op ne "copy" || !$update)) { } else { # No ID supplied -- this is a brand new record + my $protocol = $r->param("protocol"); my $host = $r->param("host"); my $port = $r->param("port"); my $dbname = $r->param("dbname"); - if (!defined $host || $host eq "" || + if (!defined $protocol || $protocol eq "" || + !defined $host || $host eq "" || !defined $port || $port eq "" || !defined $dbname || $dbname eq "") { print qq[

-You must specify host, port and database name.

\n] if $update; +You must specify protocol, host, port and database name.

\n] if $update; undef $update; } else { - my $query = cql_target($host, $port, $dbname); + ### Should use a utility function for this + my $query = cql_target($protocol, $host, $port, $dbname); my $rs = $conn->search(new ZOOM::Query::CQL($query)); if ($rs->size() > 0) { - my $fakeid = xml_encode(uri_escape("$host:$port/$dbname")); + my $fakeid = + xml_encode(uri_escape(irspy_make_identifier($protocol, $host, + $port, $dbname))); print qq[

There is already a record diff --git a/web/htdocs/details/found.mc b/web/htdocs/details/found.mc index 040318e..e39a03a 100644 --- a/web/htdocs/details/found.mc +++ b/web/htdocs/details/found.mc @@ -1,4 +1,4 @@ -%# $Id: found.mc,v 1.28 2007-04-26 13:57:17 mike Exp $ +%# $Id: found.mc,v 1.29 2007-04-27 14:04:40 mike Exp $ <%once> sub print_navlink { my($params, $cond, $caption, $skip) = @_; @@ -132,9 +132,7 @@ 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"); -my $id = $xc->find("concat(e:serverInfo/e:host, ':', - e:serverInfo/e:port, '/', - e:serverInfo/e:database)"); +my $id = irspy_record2identifier($xc); push @ids, $id; diff --git a/web/htdocs/details/full.mc b/web/htdocs/details/full.mc index 19f74a2..ada79e2 100644 --- a/web/htdocs/details/full.mc +++ b/web/htdocs/details/full.mc @@ -1,4 +1,4 @@ -%# $Id: full.mc,v 1.26 2007-04-26 14:00:33 mike Exp $ +%# $Id: full.mc,v 1.27 2007-04-27 14:04:40 mike Exp $ <%args> $id @@ -81,7 +81,7 @@ if ($n == 0) {

- + diff --git a/zebra/zeerex2id.xsl b/zebra/zeerex2id.xsl index 24b7e24..fd7ed64 100644 --- a/zebra/zeerex2id.xsl +++ b/zebra/zeerex2id.xsl @@ -1,12 +1,13 @@ - + - diff --git a/zebra/zeerex2index.xsl b/zebra/zeerex2index.xsl index 89f1473..9a9615e 100644 --- a/zebra/zeerex2index.xsl +++ b/zebra/zeerex2index.xsl @@ -1,5 +1,5 @@ - + -- 1.7.10.4