Add dom_add_element() [NOT FINISHED!] and inheritance_tree()
[irspy-moved-to-github.git] / lib / ZOOM / IRSpy / Utils.pm
1 # $Id: Utils.pm,v 1.3 2006-10-31 09:26:11 mike Exp $
2
3 package ZOOM::IRSpy::Utils;
4
5 use 5.008;
6 use strict;
7 use warnings;
8
9 use Exporter 'import';
10 our @EXPORT_OK = qw(xml_encode 
11                     irspy_xpath_context
12                     dom_add_element
13                     inheritance_tree);
14
15
16 # Utility functions follow, exported for use of web UI
17
18 # I can't -- just can't, can't, can't -- believe that this function
19 # isn't provided by one of the core XML modules.  But the evidence all
20 # says that it's not: among other things, XML::Generator and
21 # Template::Plugin both roll their own.  So I will do likewise.  D'oh!
22 #
23 sub xml_encode {
24     my ($text) = @_;
25     $text =~ s/&/&/g;
26     $text =~ s/</&lt;/g;
27     $text =~ s/>/&gt;/g;
28     $text =~ s/['']/&apos;/g;
29     $text =~ s/[""]/&quot;/g;
30     return $text;
31 }
32
33
34 sub irspy_xpath_context {
35     my($zoom_record) = @_;
36
37     my $xml = $zoom_record->render();
38     my $parser = new XML::LibXML();
39     my $doc = $parser->parse_string($xml);
40     my $root = $doc->getDocumentElement();
41     my $xc = XML::LibXML::XPathContext->new($root);
42     $xc->registerNs(e => 'http://explain.z3950.org/dtd/2.0/');
43     $xc->registerNs(i => $ZOOM::IRSpy::irspy_ns);
44     return $xc;
45 }
46
47
48 sub dom_add_element {
49     my($xc, $ppath, $element, $value, @addAfter) = @_;
50
51     print "Adding '$value' at '$ppath' after (", join(", ", map { "'$_'" } @addAfter), ")<br/>\n";
52     my @nodes = $xc->findnodes($ppath);
53     if (@nodes == 0) {
54         # Oh dear, the parent node doesn't exist.  We could make it,
55         # but for now let's not and say we did.
56         warn "no parent node '$ppath': not adding '$element'='$value'";
57         return;
58     }
59
60     warn scalar(@nodes), " nodes match parent '$ppath'" if @nodes > 1;
61     my $node = $nodes[0];
62
63     if (1) {
64         my $text = xml_encode(inheritance_tree($xc));
65         $text =~ s/\n/<br\/>$1/sg;
66         print "<pre>$text</pre>\n";
67     }
68 }
69
70
71 sub inheritance_tree {
72     my($type, $level) = @_;
73     $level = 0 if !defined $level;
74     return "Woah!  Too deep, man!\n" if $level > 20;
75
76     $type = ref $type if ref $type;
77     my $text = "";
78     $text = "--> " if $level == 0;
79     $text .= ("\t" x $level) . "$type\n";
80     my @ISA = eval "\@${type}::ISA";
81     foreach my $superclass (@ISA) {
82         $text .= inheritance_tree($superclass, $level+1);
83     }
84
85     return $text;
86 }
87
88
89 #print "Loaded ZOOM::IRSpy::Utils.pm";
90
91
92 1;