OpenSRF/src/perlmods/OpenSRF/DOM.pm

   1 use XML::LibXML;
   2 use OpenSRF::Utils::Logger qw(:level);
   3
   4 package XML::LibXML::Element;
   5 use OpenSRF::EX;
   6
   7 sub AUTOLOAD {
   8         my $self = shift;
   9         (my $name = $AUTOLOAD) =~ s/.*://;   # strip fully-qualified portion
  10
  11         ### Check for recursion
  12         my $calling_method = (caller(1))[3];
  13         my @info = caller(1);
  14
  15         if( @info ) {
  16                 if ($info[0] =~ /AUTOLOAD/) { @info = caller(2); }
  17         }
  18         unless( @info ) { @info = caller(); }
  19         if( $calling_method  and $calling_method eq "XML::LibXML::Element::AUTOLOAD" ) {
  20                 throw OpenSRF::EX::PANIC ( "RECURSION! Caller [ @info ] | Object [ ".ref($self)." ]\n ** Trying to call $name", ERROR );
  21         }
  22         ### Check for recursion
  23
  24         #OpenSRF::Utils::Logger->debug( "Autoloading method for DOM: $AUTOLOAD on ".$self->toString, INTERNAL );
  25
  26         my $new_node = OpenSRF::DOM::upcast($self);
  27         OpenSRF::Utils::Logger->debug( "Autoloaded to: ".ref($new_node), INTERNAL );
  28
  29         return $new_node->$name(@_);
  30 }
  31
  32
  33
  34 #--------------------------------------------------------------------------------
  35 package OpenSRF::DOM;
  36 use base qw/XML::LibXML OpenSRF/;
  37
  38 our %_NAMESPACE_MAP = (
  39         'http://open-ils.org/xml/namespaces/oils_v1' => 'oils',
  40 );
  41
  42 our $_one_true_parser;
  43
  44 sub new {
  45         my $self = shift;
  46         return $_one_true_parser if (defined $_one_true_parser);
  47         $_one_true_parser = $self->SUPER::new(@_);
  48         $_one_true_parser->keep_blanks(0);
  49         $XML::LibXML::skipXMLDeclaration = 0;
  50         return $_one_true_parser = $self->SUPER::new(@_);
  51 }
  52
  53 sub createDocument {
  54         my $self = shift;
  55
  56         # DOM API: createDocument(namespaceURI, qualifiedName, doctype?)
  57         my $doc = XML::LibXML::Document->new("1.0", "UTF-8");
  58         my $el = $doc->createElement('root');
  59
  60         $el->setNamespace('http://open-ils.org/xml/namespaces/oils_v1', 'oils', 1);
  61         $doc->setDocumentElement($el);
  62
  63         return $doc;
  64 }
  65
  66 my %_loaded_classes;
  67 sub upcast {
  68         my $node = shift;
  69         return undef unless $node;
  70
  71         my ($ns,$tag) = split ':' => $node->nodeName;
  72
  73         return $node unless ($ns eq 'oils');
  74
  75         my $class = "OpenSRF::DOM::Element::$tag";
  76         unless (exists $_loaded_classes{$class}) {
  77                 $class->use;
  78                 $_loaded_classes{$class} = 1;
  79         }
  80         if ($@) {
  81                 OpenSRF::Utils::Logger->error("Couldn't use $class! $@");
  82         }
  83
  84         #OpenSRF::Utils::Logger->debug("Upcasting ".$node->toString." to $class", INTERNAL);
  85
  86         return bless $node => $class;
  87 }
  88
  89 #--------------------------------------------------------------------------------
  90 package OpenSRF::DOM::Node;
  91 use base 'XML::LibXML::Node';
  92
  93 sub new {
  94         my $class = shift;
  95         return bless $class->SUPER::new(@_) => $class;
  96 }
  97
  98 sub childNodes {
  99         my $self = shift;
 100         my @children = $self->_childNodes();
 101         return wantarray ? @children : OpenSRF::DOM::NodeList->new( @children );
 102 }
 103
 104 sub attributes {
 105         my $self = shift;
 106         my @attr = $self->_attributes();
 107         return wantarray ? @attr : OpenSRF::DOM::NamedNodeMap->new( @attr );
 108 }
 109
 110 sub findnodes {
 111         my ($node, $xpath) = @_;
 112         my @nodes = $node->_findnodes($xpath);
 113         if (wantarray) {
 114                 return @nodes;
 115         } else {
 116                 return OpenSRF::DOM::NodeList->new(@nodes);
 117         }
 118 }
 119
 120
 121 #--------------------------------------------------------------------------------
 122 package OpenSRF::DOM::NamedNodeMap;
 123 use base 'XML::LibXML::NamedNodeMap';
 124
 125 #--------------------------------------------------------------------------------
 126 package OpenSRF::DOM::NodeList;
 127 use base 'XML::LibXML::NodeList';
 128
 129 #--------------------------------------------------------------------------------
 130 package OpenSRF::DOM::Element;
 131 use base 'XML::LibXML::Element';
 132
 133 sub new {
 134         my $class = shift;
 135
 136         # magically create the element (tag) name, or build a blank element
 137         (my $name = $class) =~ s/^OpenSRF::DOM::Element:://;
 138         if ($name) {
 139                 $name = "oils:$name";
 140         } else {
 141                 undef $name;
 142         }
 143
 144         my $self = $class->SUPER::new($name);
 145
 146         my %attrs = @_;
 147         for my $aname (keys %attrs) {
 148                 $self->setAttribute($aname, $attrs{$aname});
 149         }
 150
 151         return $self;
 152 }
 153
 154 sub getElementsByTagName {
 155     my ( $node , $name ) = @_;
 156         my $xpath = "descendant::$name";
 157     my @nodes = $node->_findnodes($xpath);
 158         return wantarray ? @nodes : OpenSRF::DOM::NodeList->new(@nodes);
 159 }
 160
 161 sub  getElementsByTagNameNS {
 162     my ( $node, $nsURI, $name ) = @_;
 163     my $xpath = "descendant::*[local-name()='$name' and namespace-uri()='$nsURI']";
 164     my @nodes = $node->_findnodes($xpath);
 165     return wantarray ? @nodes : OpenSRF::DOM::NodeList->new(@nodes);
 166 }
 167
 168 sub getElementsByLocalName {
 169     my ( $node,$name ) = @_;
 170     my $xpath = "descendant::*[local-name()='$name']";
 171     my @nodes = $node->_findnodes($xpath);
 172     return wantarray ? @nodes : OpenSRF::DOM::NodeList->new(@nodes);
 173 }
 174
 175 sub getChildrenByLocalName {
 176     my ( $node,$name ) = @_;
 177     my $xpath = "./*[local-name()='$name']";
 178     my @nodes = $node->_findnodes($xpath);
 179     return @nodes;
 180 }
 181
 182 sub getChildrenByTagName {
 183     my ( $node, $name ) = @_;
 184     my @nodes = grep { $_->nodeName eq $name } $node->childNodes();
 185     return @nodes;
 186 }
 187
 188 sub getChildrenByTagNameNS {
 189     my ( $node, $nsURI, $name ) = @_;
 190     my $xpath = "*[local-name()='$name' and namespace-uri()='$nsURI']";
 191     my @nodes = $node->_findnodes($xpath);
 192     return @nodes;
 193 }
 194
 195 sub appendWellBalancedChunk {
 196     my ( $self, $chunk ) = @_;
 197
 198     my $local_parser = OpenSRF::DOM->new();
 199     my $frag = $local_parser->parse_xml_chunk( $chunk );
 200
 201     $self->appendChild( $frag );
 202 }
 203
 204 package OpenSRF::DOM::Element::root;
 205 use base 'OpenSRF::DOM::Element';
 206
 207 #--------------------------------------------------------------------------------
 208 package OpenSRF::DOM::Text;
 209 use base 'XML::LibXML::Text';
 210
 211
 212 #--------------------------------------------------------------------------------
 213 package OpenSRF::DOM::Comment;
 214 use base 'XML::LibXML::Comment';
 215
 216 #--------------------------------------------------------------------------------
 217 package OpenSRF::DOM::CDATASection;
 218 use base 'XML::LibXML::CDATASection';
 219
 220 #--------------------------------------------------------------------------------
 221 package OpenSRF::DOM::Document;
 222 use base 'XML::LibXML::Document';
 223
 224 sub empty {
 225         my $self = shift;
 226         return undef unless (ref($self));
 227         $self->documentElement->removeChild($_) for $self->documentElement->childNodes;
 228         return $self;
 229 }
 230
 231 sub new {
 232         my $class = shift;
 233         return bless $class->SUPER::new(@_) => $class;
 234 }
 235
 236 sub getElementsByTagName {
 237         my ( $doc , $name ) = @_;
 238         my $xpath = "descendant-or-self::node()/$name";
 239         my @nodes = $doc->_findnodes($xpath);
 240         return wantarray ? @nodes : OpenSRF::DOM::NodeList->new(@nodes);
 241 }
 242
 243 sub  getElementsByTagNameNS {
 244         my ( $doc, $nsURI, $name ) = @_;
 245         my $xpath = "descendant-or-self::*[local-name()='$name' and namespace-uri()='$nsURI']";
 246         my @nodes = $doc->_findnodes($xpath);
 247         return wantarray ? @nodes : OpenSRF::DOM::NodeList->new(@nodes);
 248 }
 249
 250 sub getElementsByLocalName {
 251         my ( $doc,$name ) = @_;
 252         my $xpath = "descendant-or-self::*[local-name()='$name']";
 253         my @nodes = $doc->_findnodes($xpath);
 254         return wantarray ? @nodes : OpenSRF::DOM::NodeList->new(@nodes);
 255 }
 256
 257 #--------------------------------------------------------------------------------
 258 package OpenSRF::DOM::DocumentFragment;
 259 use base 'XML::LibXML::DocumentFragment';
 260
 261 #--------------------------------------------------------------------------------
 262 package OpenSRF::DOM::Attr;
 263 use base 'XML::LibXML::Attr';
 264
 265 #--------------------------------------------------------------------------------
 266 package OpenSRF::DOM::Dtd;
 267 use base 'XML::LibXML::Dtd';
 268
 269 #--------------------------------------------------------------------------------
 270 package OpenSRF::DOM::PI;
 271 use base 'XML::LibXML::PI';
 272
 273 #--------------------------------------------------------------------------------
 274 package OpenSRF::DOM::Namespace;
 275 use base 'XML::LibXML::Namespace';
 276
 277 sub isEqualNode {
 278         my ( $self, $ref ) = @_;
 279         if ( $ref->isa("XML::LibXML::Namespace") ) {
 280                 return $self->_isEqual($ref);
 281         }
 282         return 0;
 283 }
 284
 285 #--------------------------------------------------------------------------------
 286 package OpenSRF::DOM::Schema;
 287 use base 'XML::LibXML::Schema';
 288
 289 1;