3 # $Id: test-xml-update.pl,v 1.5 2006-11-09 15:18:14 mike Exp $
6 # perl -I ../lib ./test-xml-update.pl bagel.indexdata.dk:210/gils title "Test Database" author "Adam" description "This is a nice database"
12 use ZOOM::IRSpy::Utils qw(irspy_xpath_context modify_xml_document);
13 use ZOOM::IRSpy; # For _really_rewrite_record()
15 # This array copied from ../web/htdocs/details/edit.mc
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",
23 [ username => 0, "Username (if needed)", "e:serverInfo/e:authentication/e:user",
25 [ password => 0, "Password (if needed)", "e:serverInfo/e:authentication/e:password",
27 [ title => 0, "title", "e:databaseInfo/e:title",
29 [ description => 5, "Description", "e:databaseInfo/e:description",
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) ],
48 if (!getopts('wnd', \%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 " -d Show differences between old and new XML\n";
55 my($id, %data) = @ARGV;
57 my $conn = new ZOOM::Connection("localhost:3313/IR-Explain---1", 0,
58 user => "admin", password => "fruitbat");
59 $conn->option(elementSetName => "zeerex");
62 my $query = qq[rec.id="$qid"];
63 my $rs = $conn->search(new ZOOM::Query::CQL($query));
66 print STDERR "$0: no record with ID '$id'";
70 my $rec = $rs->record(0);
71 my $xc = irspy_xpath_context($rec);
72 my %fieldsByKey = map { ( $_->[0], $_) } @fields;
74 my $oldText = $xc->getContextNode()->toString();
75 my $nchanges = modify_xml_document($xc, \%fieldsByKey, \%data);
76 my $newText = $xc->getContextNode()->toString();
77 print "Document modified with $nchanges change", $nchanges==1?"":"s", "\n";
80 ZOOM::IRSpy::_really_rewrite_record($conn, $xc->getContextNode());
81 print "Rewrote record '$id'\n";
85 # For some reason, $xc->find() will not work on newly added nodes
86 # -- it returns empty strings -- so we need to make a new
87 # XPathContext. Unfortunately, we can't just go ahead and make it
88 # by parsing the new text, since it will in general include
89 # references to namespaces that are not explicitly defined in the
90 # document. So in the absence of $parser->registerNamespace() or
91 # similar, we are reduced to regexp-hackery to introduce the
92 # namespace. Ouch ouch ouch ouch ouch.
94 $t2 =~ s@>@ xmlns:e='http://explain.z3950.org/dtd/2.0/'>@;
95 my $newXc = irspy_xpath_context($t2);
97 foreach my $key (sort keys %data) {
98 my $ref = $fieldsByKey{$key};
99 my($name, $nlines, $caption, $xpath, @addAfter) = @$ref;
100 my $val = $xc->findvalue($xpath);
101 my $val2 = $newXc->findvalue($xpath);
102 print "New $caption ($xpath) = '$val' = '$val2'\n";
107 my $oldFile = "/tmp/old.txu.$$";
108 my $newFile = "/tmp/new.txu.$$";
109 open OLD, ">$oldFile";
112 open NEW, ">/tmp/new.txu.$$";
115 system("diff $oldFile $newFile");