bin/test-xml-update.pl

   1 #!/usr/bin/perl -w
   2
   3 # $Id: test-xml-update.pl,v 1.3 2006-11-07 16:29:54 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 ZOOM;
  11 use ZOOM::IRSpy::Utils qw(irspy_xpath_context modify_xml_document);
  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 if (@ARGV < 1 || @ARGV % 2 == 0) {
  46     print STDERR "Usage: %0 <id> [<key1> <value1> ...]\n";
  47     exit 1;
  48 }
  49 my($id, %data) = @ARGV;
  50
  51 my $conn = new ZOOM::Connection("localhost:3313/IR-Explain---1", 0,
  52                                 user => "admin", password => "fruitbat");
  53 $conn->option(elementSetName => "zeerex");
  54 my $qid = $id;
  55 $qid =~ s/"/\\"/g;
  56 my $query = qq[rec.id="$qid"];
  57 my $rs = $conn->search(new ZOOM::Query::CQL($query));
  58 my $n = $rs->size();
  59 if ($n == 0) {
  60     print STDERR "$0: no record with ID '$id'";
  61     exit 2;
  62 }
  63
  64 my $rec = $rs->record(0);
  65 my $xc = irspy_xpath_context($rec);
  66 my %fieldsByKey = map { ( $_->[0], $_) } @fields;
  67 my $oldText = $xc->getContextNode()->toString();
  68 my $nchanges = modify_xml_document($xc, \%fieldsByKey, \%data);
  69 my $newText = $xc->getContextNode()->toString();
  70 #ZOOM::IRSpy::_really_rewrite_record($conn, $xc->getContextNode());
  71 print "The record has been updated (nchanges=$nchanges).\n";
  72
  73 # Now display diffs between the original and modified records
  74 my $oldFile = "/tmp/old.txu.$$";
  75 my $newFile = "/tmp/new.txu.$$";
  76 open OLD, ">$oldFile";
  77 print OLD $oldText;
  78 close OLD;
  79 open NEW, ">/tmp/new.txu.$$";
  80 print NEW $newText;
  81 close NEW;
  82 system("diff $oldFile $newFile");
  83 unlink($oldFile);
  84 unlink($newFile);