X-Git-Url: http://git.indexdata.com/?p=irspy-moved-to-github.git;a=blobdiff_plain;f=bin%2Ftest-xml-update.pl;h=8cc551c6dda3f17096977c0f3f36e959ed37d999;hp=f34b12869fb00aaa36938c70ebfea2e5841e3560;hb=7000d72c8cf061be6be741b1d66354ce92697b33;hpb=1a2177d0d492794e7feed3b5fed35cbb2212786e diff --git a/bin/test-xml-update.pl b/bin/test-xml-update.pl index f34b128..8cc551c 100755 --- a/bin/test-xml-update.pl +++ b/bin/test-xml-update.pl @@ -1,9 +1,9 @@ #!/usr/bin/perl -w -# $Id: test-xml-update.pl,v 1.4 2006-11-08 17:19:18 mike Exp $ +# $Id: test-xml-update.pl,v 1.9 2007-03-19 18:50:22 mike Exp $ # # Run like this: -# perl -I ../lib ./test-xml-update.pl bagel.indexdata.dk:210/gils title "Test Database" author "Adam" description "This is a nice database"Fr +# 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; @@ -24,7 +24,7 @@ my @fields = qw() ], [ password => 0, "Password (if needed)", "e:serverInfo/e:authentication/e:password", qw(e:user) ], - [ title => 0, "title", "e:databaseInfo/e:title", + [ title => 0, "Title", "e:databaseInfo/e:title", qw() ], [ description => 5, "Description", "e:databaseInfo/e:description", qw(e:title) ], @@ -45,16 +45,17 @@ my @fields = ); my %opts; -if (!getopts('wnd', \%opts) || @ARGV % 2 == 0) { +if (!getopts('wnxd', \%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 " -x Show new XML document with changes made\n"; print STDERR " -d Show differences between old and new XML\n"; exit 1; } my($id, %data) = @ARGV; -my $conn = new ZOOM::Connection("localhost:3313/IR-Explain---1", 0, +my $conn = new ZOOM::Connection("localhost:8018/IR-Explain---1", 0, user => "admin", password => "fruitbat"); $conn->option(elementSetName => "zeerex"); my $qid = $id; @@ -72,37 +73,29 @@ 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 @changedFields = modify_xml_document($xc, \%fieldsByKey, \%data); +my $nchanges = @changedFields; my $newText = $xc->getContextNode()->toString(); -print "Document modified with $nchanges change", $nchanges==1?"":"s", "\n"; +print("Document modified with $nchanges change", $nchanges == 1 ? "" : "s", + ": ", join(", ", map { $_->[2] } @changedFields), "\n"); if ($opts{w}) { - ZOOM::IRSpy::_really_rewrite_record($conn, $xc->getContextNode()); + ZOOM::IRSpy::_really_rewrite_record($conn, $xc->getContextNode(), $id); 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); - 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"; + print "New $caption ($xpath) = '", $xc->findvalue($xpath), "'\n"; } } +if ($opts{x}) { + print $newText; +} + if ($opts{d}) { my $oldFile = "/tmp/old.txu.$$"; my $newFile = "/tmp/new.txu.$$";