1 # $Id: Utils.pm,v 1.4 2006-11-01 10:13:26 mike Exp $
3 package ZOOM::IRSpy::Utils;
10 our @EXPORT_OK = qw(xml_encode
16 use XML::LibXML::XPathContext;
18 our $IRSPY_NS = 'http://indexdata.com/irspy/1.0';
21 # Utility functions follow, exported for use of web UI
23 # I can't -- just can't, can't, can't -- believe that this function
24 # isn't provided by one of the core XML modules. But the evidence all
25 # says that it's not: among other things, XML::Generator and
26 # Template::Plugin both roll their own. So I will do likewise. D'oh!
33 $text =~ s/['']/'/g;
34 $text =~ s/[""]/"/g;
39 sub irspy_xpath_context {
40 my($zoom_record) = @_;
42 my $xml = $zoom_record->render();
43 my $parser = new XML::LibXML();
44 my $doc = $parser->parse_string($xml);
45 my $root = $doc->getDocumentElement();
46 my $xc = XML::LibXML::XPathContext->new($root);
47 $xc->registerNs(e => 'http://explain.z3950.org/dtd/2.0/');
48 $xc->registerNs(i => $IRSPY_NS);
53 sub modify_xml_document {
54 my($xc, $fieldsByKey, $data) = @_;
57 foreach my $key (keys %$data) {
58 my $value = $data->{$key};
59 my $ref = $fieldsByKey->{$key} or die "no field '$key'";
60 my($name, $nlines, $caption, $xpath, @addAfter) = @$ref;
61 #print "Considering $key='$value' ($xpath)<br/>\n";
62 my @nodes = $xc->findnodes($xpath);
64 warn scalar(@nodes), " nodes match '$xpath'" if @nodes > 1;
67 if ($node->isa("XML::LibXML::Attr")) {
68 if ($value ne $node->getValue()) {
69 $node->setValue($value);
71 print "Attr $key: '", $node->getValue(), "' -> '$value' ($xpath)<br/>\n";
73 } elsif ($node->isa("XML::LibXML::Element")) {
74 my $child = $node->firstChild();
75 ### Next line fails if data contains a comment ... *sigh*
76 die "element child $child is not text"
77 if !ref $child || !$child->isa("XML::LibXML::Text");
78 if ($value ne $child->getData()) {
79 $child->setData($value);
81 print "Elem $key: '", $child->getData(), "' -> '$value' ($xpath)<br/>\n";
84 warn "unexpected node type $node";
88 next if !$value; # No need to create a new empty node
89 my($ppath, $element) = $xpath =~ /(.*)\/(.*)/;
90 dom_add_element($xc, $ppath, $element, $value, @addAfter);
91 print "Add $key ($xpath) = '$value'<br/>\n";
100 sub dom_add_element {
101 my($xc, $ppath, $element, $value, @addAfter) = @_;
103 print "Adding '$value' at '$ppath' after (", join(", ", map { "'$_'" } @addAfter), ")<br/>\n";
104 my @nodes = $xc->findnodes($ppath);
106 # Oh dear, the parent node doesn't exist. We could make it,
107 # but for now let's not and say we did.
108 warn "no parent node '$ppath': not adding '$element'='$value'";
112 warn scalar(@nodes), " nodes match parent '$ppath'" if @nodes > 1;
113 my $node = $nodes[0];
116 my $text = xml_encode(inheritance_tree($xc));
117 $text =~ s/\n/<br\/>$1/sg;
118 print "<pre>$text</pre>\n";
123 sub inheritance_tree {
124 my($type, $level) = @_;
125 $level = 0 if !defined $level;
126 return "Woah! Too deep, man!\n" if $level > 20;
128 $type = ref $type if ref $type;
130 $text = "--> " if $level == 0;
131 $text .= ("\t" x $level) . "$type\n";
132 my @ISA = eval "\@${type}::ISA";
133 foreach my $superclass (@ISA) {
134 $text .= inheritance_tree($superclass, $level+1);
141 #print "Loaded ZOOM::IRSpy::Utils.pm";