Getting ready to model the irspy xml into zeerex using xslt.

[irspy-moved-to-github.git] / lib / ZOOM / IRSpy.pm

diff --git a/lib/ZOOM/IRSpy.pm b/lib/ZOOM/IRSpy.pm
index cd1702c..15d1124 100644 (file)
--- a/lib/ZOOM/IRSpy.pm
+++ b/lib/ZOOM/IRSpy.pm
@@ -1,4 +1,4 @@
-# $Id: IRSpy.pm,v 1.33 2006-10-17 16:22:17 mike Exp $
+# $Id: IRSpy.pm,v 1.37 2006-10-26 13:39:13 sondberg Exp $
 
 package ZOOM::IRSpy;
 
@@ -6,7 +6,14 @@ use 5.008;
 use strict;
 use warnings;
 
-use Data::Dumper; # For debugging only
+use Exporter 'import';
+our @EXPORT_OK = qw(xml_encode irspy_xpath_context);
+
+use Data::Dumper;              # For debugging only
+use File::Basename;
+use XML::LibXSLT;
+use XML::LibXML;
+use XML::LibXML::XPathContext;
 use ZOOM;
 use Net::Z3950::ZOOM 1.13;     # For the ZOOM version-check only
 use ZOOM::IRSpy::Node;
@@ -16,6 +23,7 @@ use ZOOM::IRSpy::Record;
 our @ISA = qw();
 our $VERSION = '0.02';
 our $irspy_ns = 'http://indexdata.com/irspy/1.0';
+our $irspy_to_zeerex_xsl = dirname(__FILE__) . '/../../xsl/irspy2zeerex.xsl';
 
 
 # Enumeration for callback functions to return
@@ -65,12 +73,19 @@ sub new {
     my $conn = new ZOOM::Connection($dbname, 0, @options)
        or die "$0: can't connection to IRSpy database 'dbname'";
 
+    my $xslt = new XML::LibXSLT;
+    my $libxml = new XML::LibXML;
+    my $xsl_doc = $libxml->parse_file($irspy_to_zeerex_xsl);
+    my $irspy_to_zeerex_style = $xslt->parse_stylesheet($xsl_doc);
+
     my $this = bless {
        conn => $conn,
        allrecords => 1,        # unless overridden by targets()
        query => undef,         # filled in later
        targets => undef,       # filled in later
        connections => undef,   # filled in later
+        libxml => $libxml,
+        irspy_to_zeerex_style => $xslt->parse_stylesheet($xsl_doc),
        tests => [],            # stack of tests currently being executed
     }, $class;
     $this->log("irspy", "starting up with database '$dbname'");
@@ -225,15 +240,25 @@ sub _render_record {
 }
 
 
+sub _irspy_to_zeerex {
+    my ($this, $conn) = @_;
+    my $irspy_doc = $conn->record()->{zeerex}->ownerDocument;
+    my %params = ();
+    my $result = $this->{irspy_to_zeerex_style}->transform($irspy_doc, %params);
+
+    return $result->documentElement();
+}
+
+
 sub _rewrite_record {
     my $this = shift();
     my($conn) = @_;
 
     $conn->log("irspy", "rewriting XML record");
-    my $rec = $conn->record();
+    my $rec = $this->_irspy_to_zeerex($conn);
     my $p = $this->{conn}->package();
     $p->option(action => "specialUpdate");
-    my $xml = $rec->{zeerex}->toString();
+    my $xml = $rec->toString();
     $p->option(record => $xml);
     $p->send("update");
     $p->destroy();
@@ -338,7 +363,7 @@ sub check {
 
                my $task = $conn->next_task();
                die "no next task queued for $conn" if !defined $task;
-               $conn->log("irspy_task", "starting task $task");
+               $conn->log("irspy_task", "preparing task $task");
                $conn->next_task(0);
                $conn->current_task($task);
                $task->run();
@@ -417,6 +442,8 @@ sub check {
                    $nskipped += $n;
                }
            }
+       } else {
+           die "unknown callback return-value '$res'";
        }
     }
 
@@ -491,7 +518,7 @@ sub _last_sibling_test {
        my $maybe = $this->_next_sibling_test($address);
        last if !defined $maybe;
        $nskipped++;
-       $this->log("irspy", "skipping $nskipped = '$address'");
+       $this->log("irspy", "skipping $nskipped tests to '$address'");
        $address = $maybe;
     }
 
@@ -511,6 +538,37 @@ sub _next_sibling_test {
 }
 
 
+# Utility functions follow, exported for use of web UI
+
+# I can't -- just can't, can't, can't -- believe that this function
+# isn't provided by one of the core XML modules.  But the evidence all
+# says that it's not: among other things, XML::Generator and
+# Template::Plugin both roll their own.  So I will do likewise.  D'oh!
+#
+sub xml_encode {
+    my ($text) = @_;
+    $text =~ s/&/&/g;
+    $text =~ s/</&lt;/g;
+    $text =~ s/>/&gt;/g;
+    $text =~ s/['']/&apos;/g;
+    $text =~ s/[""]/&quot;/g;
+    return $text;
+}
+
+
+sub irspy_xpath_context {
+    my($zoom_record) = @_;
+
+    my $xml = $zoom_record->render();
+    my $parser = new XML::LibXML();
+    my $doc = $parser->parse_string($xml);
+    my $root = $doc->getDocumentElement();
+    my $xc = XML::LibXML::XPathContext->new($root);
+    $xc->registerNs(e => 'http://explain.z3950.org/dtd/2.0/');
+    return $xc;
+}
+
+
 =head1 SEE ALSO
 
 ZOOM::IRSpy::Record,