X-Git-Url: http://git.indexdata.com/?p=irspy-moved-to-github.git;a=blobdiff_plain;f=bin%2Ftest-xml-update.pl;h=eeb7065a6bbcc1f6f598fd74bb144059b8bb63ef;hp=7efb6418d4624efb26a9a2cd3243db5679e0d68a;hb=53b4b1887e400850708e8f6a38f3cba6684d1e04;hpb=59bc9fc7b8da3a8239628dfe3c04d7f6c7bc4362 diff --git a/bin/test-xml-update.pl b/bin/test-xml-update.pl index 7efb641..eeb7065 100755 --- a/bin/test-xml-update.pl +++ b/bin/test-xml-update.pl @@ -1,14 +1,16 @@ #!/usr/bin/perl -w -# $Id: test-xml-update.pl,v 1.2 2006-11-01 10:31:57 mike Exp $ +# $Id: test-xml-update.pl,v 1.5 2006-11-09 15:18:14 mike Exp $ # # Run like this: -# perl -I ../lib ./test-xml-update.pl bagel.indexdata.dk:210/gils +# 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() # This array copied from ../web/htdocs/details/edit.mc my @fields = @@ -42,8 +44,12 @@ my @fields = qw(e:title e:description) ], ); -if (@ARGV < 1 || @ARGV % 2 == 0) { - print STDERR "Usage: %0 [ ...]\n"; +my %opts; +if (!getopts('wnd', \%opts) || @ARGV % 2 == 0) { + print STDERR "Usage: %0 [options] [ ...]\n"; + print STDERR " -w Write modified record back to DB\n"; + print STDERR " -n Show new values of fields using XPath\n"; + print STDERR " -d Show differences between old and new XML\n"; exit 1; } my($id, %data) = @ARGV; @@ -64,21 +70,49 @@ if ($n == 0) { my $rec = $rs->record(0); 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 $newText = $xc->getContextNode()->toString(); -#ZOOM::IRSpy::_really_rewrite_record($conn, $xc->getContextNode()); -print "The record has been updated (nchanges=$nchanges).\n"; +print "Document modified with $nchanges change", $nchanges==1?"":"s", "\n"; + +if ($opts{w}) { + ZOOM::IRSpy::_really_rewrite_record($conn, $xc->getContextNode()); + 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); -# Now display diffs between the original and modified records -my $oldFile = "/tmp/old.txu.$$"; -my $newFile = "/tmp/new.txu.$$"; -open OLD, ">$oldFile"; -print OLD $oldText; -close OLD; -open NEW, ">/tmp/new.txu.$$"; -print NEW $newText; -close NEW; -system("diff $oldFile $newFile"); -unlink($oldFile); -unlink($newFile); + 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"; + } +} + +if ($opts{d}) { + my $oldFile = "/tmp/old.txu.$$"; + my $newFile = "/tmp/new.txu.$$"; + open OLD, ">$oldFile"; + print OLD $oldText; + close OLD; + open NEW, ">/tmp/new.txu.$$"; + print NEW $newText; + close NEW; + system("diff $oldFile $newFile"); + unlink($oldFile); + unlink($newFile); +}