bin/test-xml-update.pl

   1 #!/usr/bin/perl
   2 #
   3 # Run like this:
   4 #       perl -I ../lib ./test-xml-update.pl bagel.indexdata.dk:210/gils title "Test Database" author "Adam" description "This is a nice database"
   5
   6 use strict;
   7 use warnings;
   8 use Getopt::Std;
   9 use ZOOM;
  10 use ZOOM::IRSpy::Utils qw(irspy_xpath_context modify_xml_document);
  11 use ZOOM::IRSpy;                # For _rewrite_zeerex_record()
  12
  13 # This array copied from ../web/htdocs/details/edit.mc
  14 my @fields =
  15     (
  16      [ protocol     => 0, "Protocol", "e:serverInfo/\@protocol" ],
  17      [ host         => 0, "Host", "e:serverInfo/e:host" ],
  18      [ port         => 0, "Port", "e:serverInfo/e:port" ],
  19      [ dbname       => 0, "Database Name", "e:serverInfo/e:database",
  20        qw(e:host e:port) ],
  21      [ username     => 0, "Username (if needed)", "e:serverInfo/e:authentication/e:user",
  22        qw() ],
  23      [ password     => 0, "Password (if needed)", "e:serverInfo/e:authentication/e:password",
  24        qw(e:user) ],
  25      [ title        => 0, "Title", "e:databaseInfo/e:title",
  26        qw() ],
  27      [ description  => 5, "Description", "e:databaseInfo/e:description",
  28        qw(e:title) ],
  29      [ author       => 0, "Author", "e:databaseInfo/e:author",
  30        qw(e:title e:description) ],
  31      [ contact      => 0, "Contact", "e:databaseInfo/e:contact",
  32        qw(e:title e:description) ],
  33      [ extent       => 3, "Extent", "e:databaseInfo/e:extent",
  34        qw(e:title e:description) ],
  35      [ history      => 5, "History", "e:databaseInfo/e:history",
  36        qw(e:title e:description) ],
  37      [ language     => 0, "Language of Records", "e:databaseInfo/e:langUsage",
  38        qw(e:title e:description) ],
  39      [ restrictions => 2, "Restrictions", "e:databaseInfo/e:restrictions",
  40        qw(e:title e:description) ],
  41      [ subjects     => 2, "Subjects", "e:databaseInfo/e:subjects",
  42        qw(e:title e:description) ],
  43      );
  44
  45 my %opts;
  46 if (!getopts('wnxd', \%opts) || @ARGV % 2 == 0) {
  47     print STDERR "Usage: %0 [options] <id> [<key1> <value1> ...]\n";
  48     print STDERR "      -w      Write modified record back to DB\n";
  49     print STDERR "      -n      Show new values of fields using XPath\n";
  50     print STDERR "      -x      Show new XML document with changes made\n";
  51     print STDERR "      -d      Show differences between old and new XML\n";
  52     exit 1;
  53 }
  54 my($id, %data) = @ARGV;
  55
  56 my $conn = new ZOOM::Connection("localhost:8018/IR-Explain---1", 0,
  57                                 user => "admin", password => "fruitbat");
  58 $conn->option(elementSetName => "zeerex");
  59 my $qid = $id;
  60 $qid =~ s/"/\\"/g;
  61 my $query = qq[rec.id="$qid"];
  62 my $rs = $conn->search(new ZOOM::Query::CQL($query));
  63 my $n = $rs->size();
  64 if ($n == 0) {
  65     print STDERR "$0: no record with ID '$id'";
  66     exit 2;
  67 }
  68
  69 my $rec = $rs->record(0);
  70 my $xc = irspy_xpath_context($rec);
  71 my %fieldsByKey = map { ( $_->[0], $_) } @fields;
  72
  73 my $oldText = $xc->getContextNode()->toString();
  74 my @changedFields = modify_xml_document($xc, \%fieldsByKey, \%data);
  75 my $nchanges = @changedFields;
  76 my $newText = $xc->getContextNode()->toString();
  77 print("Document modified with $nchanges change", $nchanges == 1 ? "" : "s",
  78       ": ", join(", ", map { $_->[2] } @changedFields), "\n");
  79
  80 if ($opts{w}) {
  81     ZOOM::IRSpy::_rewrite_zeerex_record($conn, $xc->getContextNode(), $id);
  82     print "Rewrote record '$id'\n";
  83 }
  84
  85 if ($opts{n}) {
  86     foreach my $key (sort keys %data) {
  87         my $ref = $fieldsByKey{$key};
  88         my($name, $nlines, $caption, $xpath, @addAfter) = @$ref;
  89         print "New $caption ($xpath) = '", $xc->findvalue($xpath), "'\n";
  90     }
  91 }
  92
  93 if ($opts{x}) {
  94     print $newText;
  95 }
  96
  97 if ($opts{d}) {
  98     my $oldFile = "/tmp/old.txu.$$";
  99     my $newFile = "/tmp/new.txu.$$";
 100     open OLD, ">$oldFile";
 101     print OLD $oldText;
 102     close OLD;
 103     open NEW, ">/tmp/new.txu.$$";
 104     print NEW $newText;
 105     close NEW;
 106     system("diff $oldFile $newFile");
 107     unlink($oldFile);
 108     unlink($newFile);
 109 }