Update sample command-line comment for moved rules file.
[irspy-moved-to-github.git] / bin / test-xml-update.pl
index f34b128..f9b37fd 100755 (executable)
@@ -1,16 +1,14 @@
-#!/usr/bin/perl -w
-
-# $Id: test-xml-update.pl,v 1.4 2006-11-08 17:19:18 mike Exp $
+#!/usr/bin/perl
 #
 # Run like this:
-#      perl -I ../lib ./test-xml-update.pl bagel.indexdata.dk:210/gils title "Test Database" author "Adam" description "This is a nice database"Fr
+#      perl -I ../lib ./test-xml-update.pl bagel.indexdata.dk:210/gils title "Test Database" author "Adam" description "This is a nice database"
 
 use strict;
 use warnings;
 use Getopt::Std;
 use ZOOM;
 use ZOOM::IRSpy::Utils qw(irspy_xpath_context modify_xml_document);
-use ZOOM::IRSpy;               # For _really_rewrite_record()
+use ZOOM::IRSpy;               # For _rewrite_zeerex_record()
 
 # This array copied from ../web/htdocs/details/edit.mc
 my @fields =
@@ -24,7 +22,7 @@ my @fields =
        qw() ],
      [ password     => 0, "Password (if needed)", "e:serverInfo/e:authentication/e:password",
        qw(e:user) ],
-     [ title        => 0, "title", "e:databaseInfo/e:title",
+     [ title        => 0, "Title", "e:databaseInfo/e:title",
        qw() ],
      [ description  => 5, "Description", "e:databaseInfo/e:description",
        qw(e:title) ],
@@ -45,16 +43,17 @@ my @fields =
      );
 
 my %opts;
-if (!getopts('wnd', \%opts) || @ARGV % 2 == 0) {
+if (!getopts('wnxd', \%opts) || @ARGV % 2 == 0) {
     print STDERR "Usage: %0 [options] <id> [<key1> <value1> ...]\n";
     print STDERR "     -w      Write modified record back to DB\n";
     print STDERR "     -n      Show new values of fields using XPath\n";
+    print STDERR "     -x      Show new XML document with changes made\n";
     print STDERR "     -d      Show differences between old and new XML\n";
     exit 1;
 }
 my($id, %data) = @ARGV;
 
-my $conn = new ZOOM::Connection("localhost:3313/IR-Explain---1", 0,
+my $conn = new ZOOM::Connection("localhost:8018/IR-Explain---1", 0,
                                user => "admin", password => "fruitbat");
 $conn->option(elementSetName => "zeerex");
 my $qid = $id;
@@ -72,37 +71,29 @@ my $xc = irspy_xpath_context($rec);
 my %fieldsByKey = map { ( $_->[0], $_) } @fields;
 
 my $oldText = $xc->getContextNode()->toString();
-my $nchanges = modify_xml_document($xc, \%fieldsByKey, \%data);
+my @changedFields = modify_xml_document($xc, \%fieldsByKey, \%data);
+my $nchanges = @changedFields;
 my $newText = $xc->getContextNode()->toString();
-print "Document modified with $nchanges change", $nchanges==1?"":"s", "\n";
+print("Document modified with $nchanges change", $nchanges == 1 ? "" : "s",
+      ": ", join(", ", map { $_->[2] } @changedFields), "\n");
 
 if ($opts{w}) {
-    ZOOM::IRSpy::_really_rewrite_record($conn, $xc->getContextNode());
+    ZOOM::IRSpy::_rewrite_zeerex_record($conn, $xc->getContextNode(), $id);
     print "Rewrote record '$id'\n";
 }
 
 if ($opts{n}) {
-    # For some reason, $xc->find() will not work on newly added nodes
-    # -- it returns empty strings -- so we need to make a new
-    # XPathContext.  Unfortunately, we can't just go ahead and make it
-    # by parsing the new text, since it will in general include
-    # references to namespaces that are not explicitly defined in the
-    # document.  So in the absence of $parser->registerNamespace() or
-    # similar, we are reduced to regexp-hackery to introduce the
-    # namespace.  Ouch ouch ouch ouch ouch.
-    my $t2 = $newText;
-    $t2 =~ s@>@ xmlns:e='http://explain.z3950.org/dtd/2.0/'>@;
-    my $newXc = irspy_xpath_context($t2);
-
     foreach my $key (sort keys %data) {
        my $ref = $fieldsByKey{$key};
        my($name, $nlines, $caption, $xpath, @addAfter) = @$ref;
-       my $val = $xc->findvalue($xpath);
-       my $val2 = $newXc->findvalue($xpath);
-       print "New $caption ($xpath) = '$val' = '$val2'\n";
+       print "New $caption ($xpath) = '", $xc->findvalue($xpath), "'\n";
     }
 }
 
+if ($opts{x}) {
+    print $newText;
+}
+
 if ($opts{d}) {
     my $oldFile = "/tmp/old.txu.$$";
     my $newFile = "/tmp/new.txu.$$";