-# $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;
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';
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;
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);
}
# 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);
-# $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;
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;
my $target = shift();
my $this = $class->SUPER::create(@_);
- $this->option(host => $target);
+ $this->option(host => irspy_identifier2target($target));
$this->{irspy} = $irspy;
$this->{tasks} = [];
$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;
}
-# $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
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__;
<explain xmlns="http://explain.z3950.org/dtd/2.0/">
- <serverInfo protocol="Z39.50" version="1995">
+ <serverInfo protocol="$xprotocol">
<host>$xhost</host>
<port>$xport</port>
<database>$xdb</database>
-# $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;
cql_quote
cql_target
irspy_xpath_context
+ irspy_make_identifier
+ irspy_record2identifier
+ irspy_identifier2target
modify_xml_document
bib1_access_point
render_record);
# 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);
}
}
+# 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) = @_;
-%# $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
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);
</%once>
% $r->content_type("text/html; charset=utf-8");
% foreach my $i ('a' .. 'z') {
<a href="/find.html?dc.title=^<% $i %>*&_sort=dc.title&_count=9999&_search=Search"><tt><% uc($i) %></tt></a>
% }
- <a href="/find.html?cql.allRecords=1+not+dc.title+=/regexp/firstInField+[a-z].*&_sort=dc.title&_count=9999&_search=Search"">[Others]</a>
+ <a href="/find.html?cql.allRecords=1+not+dc.title+=/regexp/firstInField+[a-z].*&_sort=dc.title&_count=9999&_search=Search">[Others]</a>
</p>
<%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'";
}
}
-%# $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
} 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[<p class="error">
-You must specify host, port and database name.</p>\n] if $update;
+You must specify protocol, host, port and database name.</p>\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[<p class="error">
There is already
<a href='?op=edit&id=$fakeid'>a record</a>
-%# $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) = @_;
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;
</%perl>
<tr style="background: <% ($i % 2) ? '#ffffc0' : 'white' %>">
-%# $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
</%args>
<p>
<a href="<% xml_encode("http://targettest.indexdata.com/targettest/search/index.zap?" .
join("&",
- "target=" . uri_escape_utf8($id),
+ "target=" . uri_escape_utf8(irspy_identifier2target($id)),
"name=" . uri_escape_utf8($title),
"attr=" . join(" ", list_ap($xc, "bib-1")),
"formats=" . calc_recsyn($xc, " ")))
<?xml version="1.0" encoding="UTF-8"?>
-<!-- $Id: zeerex2dc.xsl,v 1.1 2006-09-26 14:37:41 mike Exp $ -->
+<!-- $Id: zeerex2dc.xsl,v 1.2 2007-04-27 14:04:40 mike Exp $ -->
<xsl:stylesheet xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
xmlns:z="http://indexdata.dk/zebra/xslt/1"
xmlns:e="http://explain.z3950.org/dtd/2.0/"
<xsl:template match="//e:explain">
<metadata xmlns:dc="http://purl.org/dc/elements/1.1/"
- z:id="{concat(e:serverInfo/e:host, ':',
+ z:id="{concat(e:serverInfo/@protocol, ':',
+ e:serverInfo/e:host, ':',
e:serverInfo/e:port, '/',
e:serverInfo/e:database)}">
<dc:title>
<?xml version="1.0" encoding="UTF-8"?>
-<!-- $Id: zeerex2id.xsl,v 1.1 2006-05-24 16:17:12 mike Exp $ -->
+<!-- $Id: zeerex2id.xsl,v 1.2 2007-04-27 14:04:40 mike Exp $ -->
<xsl:stylesheet xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
xmlns:e="http://explain.z3950.org/dtd/2.0/"
version="1.0">
<xsl:output method="text" encoding="UTF-8" omit-xml-declaration="yes"/>
<xsl:template match="text()"/>
<xsl:template match="//e:explain">
- <xsl:value-of select="concat(e:serverInfo/e:host, ':',
+ <xsl:value-of select="concat(e:serverInfo/@protocol, ':',
+ e:serverInfo/e:host, ':',
e:serverInfo/e:port, '/',
e:serverInfo/e:database)"/>
</xsl:template>
<?xml version="1.0" encoding="UTF-8"?>
-<!-- $Id: zeerex2index.xsl,v 1.13 2007-03-29 17:13:45 mike Exp $ -->
+<!-- $Id: zeerex2index.xsl,v 1.14 2007-04-27 14:04:40 mike Exp $ -->
<!-- See the ZeeRex profile at http://srw.cheshire3.org/profiles/ZeeRex/ -->
<xsl:stylesheet xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
xmlns:z="http://indexdata.dk/zebra/xslt/1"
<!-- Match on ZeeRex XML record -->
<xsl:template match="//e:explain">
<xsl:variable name="id"><xsl:value-of select="concat(
+ e:serverInfo/@protocol, ':',
e:serverInfo/e:host, ':',
e:serverInfo/e:port, '/',
e:serverInfo/e:database)"/></xsl:variable>
projects / irspy-moved-to-github.git / commitdiff