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/&/&amp;/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;