bin/test-xml-update.pl

   1 #!/usr/bin/perl -w
   2
   3 # $Id: test-xml-update.pl,v 1.7 2006-11-29 17:22:32 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"
   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('wnxd', \%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 "      -x      Show new XML document with changes made\n";
  53     print STDERR "      -d      Show differences between old and new XML\n";
  54     exit 1;
  55 }
  56 my($id, %data) = @ARGV;
  57
  58 my $conn = new ZOOM::Connection("localhost:3313/IR-Explain---1", 0,
  59                                 user => "admin", password => "fruitbat");
  60 $conn->option(elementSetName => "zeerex");
  61 my $qid = $id;
  62 $qid =~ s/"/\\"/g;
  63 my $query = qq[rec.id="$qid"];
  64 my $rs = $conn->search(new ZOOM::Query::CQL($query));
  65 my $n = $rs->size();
  66 if ($n == 0) {
  67     print STDERR "$0: no record with ID '$id'";
  68     exit 2;
  69 }
  70
  71 my $rec = $rs->record(0);
  72 my $xc = irspy_xpath_context($rec);
  73 my %fieldsByKey = map { ( $_->[0], $_) } @fields;
  74
  75 my $oldText = $xc->getContextNode()->toString();
  76 my @changedFields = modify_xml_document($xc, \%fieldsByKey, \%data);
  77 my $nchanges = @changedFields;
  78 my $newText = $xc->getContextNode()->toString();
  79 print("Document modified with $nchanges change", $nchanges == 1 ? "" : "s",
  80       ": ", join(", ", map { $_->[2] } @changedFields), "\n");
  81
  82 if ($opts{w}) {
  83     ZOOM::IRSpy::_really_rewrite_record($conn, $xc->getContextNode());
  84     print "Rewrote record '$id'\n";
  85 }
  86
  87 if ($opts{n}) {
  88     foreach my $key (sort keys %data) {
  89         my $ref = $fieldsByKey{$key};
  90         my($name, $nlines, $caption, $xpath, @addAfter) = @$ref;
  91         print "New $caption ($xpath) = '", $xc->findvalue($xpath), "'\n";
  92     }
  93 }
  94
  95 if ($opts{x}) {
  96     print $newText;
  97 }
  98
  99 if ($opts{d}) {
 100     my $oldFile = "/tmp/old.txu.$$";
 101     my $newFile = "/tmp/new.txu.$$";
 102     open OLD, ">$oldFile";
 103     print OLD $oldText;
 104     close OLD;
 105     open NEW, ">/tmp/new.txu.$$";
 106     print NEW $newText;
 107     close NEW;
 108     system("diff $oldFile $newFile");
 109     unlink($oldFile);
 110     unlink($newFile);
 111 }