Initial revision
[OpenSRF.git] / 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                 eval "use $class;";
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;