bin/test-xml-update.pl

   1 #!/usr/bin/perl -w
   2
   3 # $Id: test-xml-update.pl,v 1.4 2006-11-08 17:19:18 mike Exp $
   4 #
   5 # Run like this:
   6 #       perl -I ../lib ./test-xml-update.pl bagel.indexdata.dk:210/gils title "Test Database" author "Adam" description "This is a nice database"Fr
   7
   8 use strict;
   9 use warnings;
  10 use Getopt::Std;
  11 use ZOOM;
  12 use ZOOM::IRSpy::Utils qw(irspy_xpath_context modify_xml_document);
  13 use ZOOM::IRSpy;                # For _really_rewrite_record()
  14
  15 # This array copied from ../web/htdocs/details/edit.mc
  16 my @fields =
  17     (
  18      [ protocol     => 0, "Protocol", "e:serverInfo/\@protocol" ],
  19      [ host         => 0, "Host", "e:serverInfo/e:host" ],
  20      [ port         => 0, "Port", "e:serverInfo/e:port" ],
  21      [ dbname       => 0, "Database Name", "e:serverInfo/e:database",
  22        qw(e:host e:port) ],
  23      [ username     => 0, "Username (if needed)", "e:serverInfo/e:authentication/e:user",
  24        qw() ],
  25      [ password     => 0, "Password (if needed)", "e:serverInfo/e:authentication/e:password",
  26        qw(e:user) ],
  27      [ title        => 0, "title", "e:databaseInfo/e:title",
  28        qw() ],
  29      [ description  => 5, "Description", "e:databaseInfo/e:description",
  30        qw(e:title) ],
  31      [ author       => 0, "Author", "e:databaseInfo/e:author",
  32        qw(e:title e:description) ],
  33      [ contact      => 0, "Contact", "e:databaseInfo/e:contact",
  34        qw(e:title e:description) ],
  35      [ extent       => 3, "Extent", "e:databaseInfo/e:extent",
  36        qw(e:title e:description) ],
  37      [ history      => 5, "History", "e:databaseInfo/e:history",
  38        qw(e:title e:description) ],
  39      [ language     => 0, "Language of Records", "e:databaseInfo/e:langUsage",
  40        qw(e:title e:description) ],
  41      [ restrictions => 2, "Restrictions", "e:databaseInfo/e:restrictions",
  42        qw(e:title e:description) ],
  43      [ subjects     => 2, "Subjects", "e:databaseInfo/e:subjects",
  44        qw(e:title e:description) ],
  45      );
  46
  47 my %opts;
  48 if (!getopts('wnd', \%opts) || @ARGV % 2 == 0) {
  49     print STDERR "Usage: %0 [options] <id> [<key1> <value1> ...]\n";
  50     print STDERR "      -w      Write modified record back to DB\n";
  51     print STDERR "      -n      Show new values of fields using XPath\n";
  52     print STDERR "      -d      Show differences between old and new XML\n";
  53     exit 1;
  54 }
  55 my($id, %data) = @ARGV;
  56
  57 my $conn = new ZOOM::Connection("localhost:3313/IR-Explain---1", 0,
  58                                 user => "admin", password => "fruitbat");
  59 $conn->option(elementSetName => "zeerex");
  60 my $qid = $id;
  61 $qid =~ s/"/\\"/g;
  62 my $query = qq[rec.id="$qid"];
  63 my $rs = $conn->search(new ZOOM::Query::CQL($query));
  64 my $n = $rs->size();
  65 if ($n == 0) {
  66     print STDERR "$0: no record with ID '$id'";
  67     exit 2;
  68 }
  69
  70 my $rec = $rs->record(0);
  71 my $xc = irspy_xpath_context($rec);
  72 my %fieldsByKey = map { ( $_->[0], $_) } @fields;
  73
  74 my $oldText = $xc->getContextNode()->toString();
  75 my $nchanges = modify_xml_document($xc, \%fieldsByKey, \%data);
  76 my $newText = $xc->getContextNode()->toString();
  77 print "Document modified with $nchanges change", $nchanges==1?"":"s", "\n";
  78
  79 if ($opts{w}) {
  80     ZOOM::IRSpy::_really_rewrite_record($conn, $xc->getContextNode());
  81     print "Rewrote record '$id'\n";
  82 }
  83
  84 if ($opts{n}) {
  85     # For some reason, $xc->find() will not work on newly added nodes
  86     # -- it returns empty strings -- so we need to make a new
  87     # XPathContext.  Unfortunately, we can't just go ahead and make it
  88     # by parsing the new text, since it will in general include
  89     # references to namespaces that are not explicitly defined in the
  90     # document.  So in the absence of $parser->registerNamespace() or
  91     # similar, we are reduced to regexp-hackery to introduce the
  92     # namespace.  Ouch ouch ouch ouch ouch.
  93     my $t2 = $newText;
  94     $t2 =~ s@>@ xmlns:e='http://explain.z3950.org/dtd/2.0/'>@;
  95     my $newXc = irspy_xpath_context($t2);
  96
  97     foreach my $key (sort keys %data) {
  98         my $ref = $fieldsByKey{$key};
  99         my($name, $nlines, $caption, $xpath, @addAfter) = @$ref;
 100         my $val = $xc->findvalue($xpath);
 101         my $val2 = $newXc->findvalue($xpath);
 102         print "New $caption ($xpath) = '$val' = '$val2'\n";
 103     }
 104 }
 105
 106 if ($opts{d}) {
 107     my $oldFile = "/tmp/old.txu.$$";
 108     my $newFile = "/tmp/new.txu.$$";
 109     open OLD, ">$oldFile";
 110     print OLD $oldText;
 111     close OLD;
 112     open NEW, ">/tmp/new.txu.$$";
 113     print NEW $newText;
 114     close NEW;
 115     system("diff $oldFile $newFile");
 116     unlink($oldFile);
 117     unlink($newFile);
 118 }