← Index
Performance Profile   « block view • line view • sub view »
For t/test-parsing
  Run on Sun Nov 14 09:49:57 2010
Reported on Sun Nov 14 09:50:09 2010

File /usr/lib/perl5/XML/LibXML.pm
Statements Executed 124
Total Time 0.0106318 seconds
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
212896µs896µsXML::LibXML::::bootstrap XML::LibXML::bootstrap(xsub)
21225µs25µsXML::LibXML::::LIBXML_RUNTIME_VERSION XML::LibXML::LIBXML_RUNTIME_VERSION(xsub)
21210µs10µsXML::LibXML::::LIBXML_VERSION XML::LibXML::LIBXML_VERSION(xsub)
0000s0sXML::LibXML::Attr::::BEGIN XML::LibXML::Attr::BEGIN
0000s0sXML::LibXML::Attr::::setNamespace XML::LibXML::Attr::setNamespace
0000s0sXML::LibXML::::BEGIN XML::LibXML::BEGIN
0000s0sXML::LibXML::CDATASection::::BEGIN XML::LibXML::CDATASection::BEGIN
0000s0sXML::LibXML::::CLONE XML::LibXML::CLONE
0000s0sXML::LibXML::Comment::::BEGIN XML::LibXML::Comment::BEGIN
0000s0sXML::LibXML::Document::::BEGIN XML::LibXML::Document::BEGIN
0000s0sXML::LibXML::Document::::actualEncoding XML::LibXML::Document::actualEncoding
0000s0sXML::LibXML::Document::::insertPI XML::LibXML::Document::insertPI
0000s0sXML::LibXML::Document::::insertProcessingInstruction XML::LibXML::Document::insertProcessingInstruction
0000s0sXML::LibXML::Document::::process_xinclude XML::LibXML::Document::process_xinclude
0000s0sXML::LibXML::Document::::serialize XML::LibXML::Document::serialize
0000s0sXML::LibXML::Document::::setDocumentElement XML::LibXML::Document::setDocumentElement
0000s0sXML::LibXML::Document::::toString XML::LibXML::Document::toString
0000s0sXML::LibXML::DocumentFragment::::BEGINXML::LibXML::DocumentFragment::BEGIN
0000s0sXML::LibXML::DocumentFragment::::toStringXML::LibXML::DocumentFragment::toString
0000s0sXML::LibXML::Dtd::::BEGIN XML::LibXML::Dtd::BEGIN
0000s0sXML::LibXML::Element::::BEGIN XML::LibXML::Element::BEGIN
0000s0sXML::LibXML::Element::::appendWellBalancedChunk XML::LibXML::Element::appendWellBalancedChunk
0000s0sXML::LibXML::Element::::getAttribute XML::LibXML::Element::getAttribute
0000s0sXML::LibXML::Element::::getAttributeNS XML::LibXML::Element::getAttributeNS
0000s0sXML::LibXML::Element::::getChildrenByLocalName XML::LibXML::Element::getChildrenByLocalName
0000s0sXML::LibXML::Element::::getChildrenByTagName XML::LibXML::Element::getChildrenByTagName
0000s0sXML::LibXML::Element::::getChildrenByTagNameNS XML::LibXML::Element::getChildrenByTagNameNS
0000s0sXML::LibXML::Element::::getElementsByLocalName XML::LibXML::Element::getElementsByLocalName
0000s0sXML::LibXML::Element::::getElementsByTagName XML::LibXML::Element::getElementsByTagName
0000s0sXML::LibXML::Element::::getElementsByTagNameNS XML::LibXML::Element::getElementsByTagNameNS
0000s0sXML::LibXML::Element::::setAttribute XML::LibXML::Element::setAttribute
0000s0sXML::LibXML::Element::::setAttributeNS XML::LibXML::Element::setAttributeNS
0000s0sXML::LibXML::Element::::setNamespace XML::LibXML::Element::setNamespace
0000s0sXML::LibXML::InputCallback::::BEGIN XML::LibXML::InputCallback::BEGIN
0000s0sXML::LibXML::InputCallback::::_callback_close XML::LibXML::InputCallback::_callback_close
0000s0sXML::LibXML::InputCallback::::_callback_match XML::LibXML::InputCallback::_callback_match
0000s0sXML::LibXML::InputCallback::::_callback_open XML::LibXML::InputCallback::_callback_open
0000s0sXML::LibXML::InputCallback::::_callback_read XML::LibXML::InputCallback::_callback_read
0000s0sXML::LibXML::InputCallback::::cleanup_callbacks XML::LibXML::InputCallback::cleanup_callbacks
0000s0sXML::LibXML::InputCallback::::init_callbacks XML::LibXML::InputCallback::init_callbacks
0000s0sXML::LibXML::InputCallback::::new XML::LibXML::InputCallback::new
0000s0sXML::LibXML::InputCallback::::register_callbacks XML::LibXML::InputCallback::register_callbacks
0000s0sXML::LibXML::InputCallback::::unregister_callbacks XML::LibXML::InputCallback::unregister_callbacks
0000s0sXML::LibXML::NamedNodeMap::::BEGIN XML::LibXML::NamedNodeMap::BEGIN
0000s0sXML::LibXML::NamedNodeMap::::getNamedItem XML::LibXML::NamedNodeMap::getNamedItem
0000s0sXML::LibXML::NamedNodeMap::::getNamedItemNS XML::LibXML::NamedNodeMap::getNamedItemNS
0000s0sXML::LibXML::NamedNodeMap::::item XML::LibXML::NamedNodeMap::item
0000s0sXML::LibXML::NamedNodeMap::::length XML::LibXML::NamedNodeMap::length
0000s0sXML::LibXML::NamedNodeMap::::new XML::LibXML::NamedNodeMap::new
0000s0sXML::LibXML::NamedNodeMap::::nodes XML::LibXML::NamedNodeMap::nodes
0000s0sXML::LibXML::NamedNodeMap::::removeNamedItem XML::LibXML::NamedNodeMap::removeNamedItem
0000s0sXML::LibXML::NamedNodeMap::::removeNamedItemNS XML::LibXML::NamedNodeMap::removeNamedItemNS
0000s0sXML::LibXML::NamedNodeMap::::setNamedItem XML::LibXML::NamedNodeMap::setNamedItem
0000s0sXML::LibXML::NamedNodeMap::::setNamedItemNS XML::LibXML::NamedNodeMap::setNamedItemNS
0000s0sXML::LibXML::Namespace::::getName XML::LibXML::Namespace::getName
0000s0sXML::LibXML::Namespace::::getNamespaceURI XML::LibXML::Namespace::getNamespaceURI
0000s0sXML::LibXML::Namespace::::getNamespaces XML::LibXML::Namespace::getNamespaces
0000s0sXML::LibXML::Namespace::::getPrefix XML::LibXML::Namespace::getPrefix
0000s0sXML::LibXML::Namespace::::isEqualNode XML::LibXML::Namespace::isEqualNode
0000s0sXML::LibXML::Namespace::::isSameNode XML::LibXML::Namespace::isSameNode
0000s0sXML::LibXML::Namespace::::name XML::LibXML::Namespace::name
0000s0sXML::LibXML::Namespace::::nodeName XML::LibXML::Namespace::nodeName
0000s0sXML::LibXML::Namespace::::prefix XML::LibXML::Namespace::prefix
0000s0sXML::LibXML::Node::::attributes XML::LibXML::Node::attributes
0000s0sXML::LibXML::Node::::childNodes XML::LibXML::Node::childNodes
0000s0sXML::LibXML::Node::::find XML::LibXML::Node::find
0000s0sXML::LibXML::Node::::findnodes XML::LibXML::Node::findnodes
0000s0sXML::LibXML::Node::::findvalue XML::LibXML::Node::findvalue
0000s0sXML::LibXML::Node::::getChildNodes XML::LibXML::Node::getChildNodes
0000s0sXML::LibXML::Node::::isSupported XML::LibXML::Node::isSupported
0000s0sXML::LibXML::Node::::setOwnerDocument XML::LibXML::Node::setOwnerDocument
0000s0sXML::LibXML::Node::::toStringC14N XML::LibXML::Node::toStringC14N
0000s0sXML::LibXML::Node::::toStringEC14N XML::LibXML::Node::toStringEC14N
0000s0sXML::LibXML::PI::::BEGIN XML::LibXML::PI::BEGIN
0000s0sXML::LibXML::PI::::setData XML::LibXML::PI::setData
0000s0sXML::LibXML::RelaxNG::::new XML::LibXML::RelaxNG::new
0000s0sXML::LibXML::Schema::::new XML::LibXML::Schema::new
0000s0sXML::LibXML::Text::::BEGIN XML::LibXML::Text::BEGIN
0000s0sXML::LibXML::Text::::attributes XML::LibXML::Text::attributes
0000s0sXML::LibXML::Text::::deleteDataString XML::LibXML::Text::deleteDataString
0000s0sXML::LibXML::Text::::replaceDataRegEx XML::LibXML::Text::replaceDataRegEx
0000s0sXML::LibXML::Text::::replaceDataString XML::LibXML::Text::replaceDataString
0000s0sXML::LibXML::_SAXParser::::BEGIN XML::LibXML::_SAXParser::BEGIN
0000s0sXML::LibXML::_SAXParser::::error XML::LibXML::_SAXParser::error
0000s0sXML::LibXML::_SAXParser::::fatal_error XML::LibXML::_SAXParser::fatal_error
0000s0sXML::LibXML::_SAXParser::::warning XML::LibXML::_SAXParser::warning
0000s0sXML::LibXML::::__read XML::LibXML::__read
0000s0sXML::LibXML::::__write XML::LibXML::__write
0000s0sXML::LibXML::::_auto_expand XML::LibXML::_auto_expand
0000s0sXML::LibXML::::_cleanup_callbacks XML::LibXML::_cleanup_callbacks
0000s0sXML::LibXML::::_html_options XML::LibXML::_html_options
0000s0sXML::LibXML::::_init_callbacks XML::LibXML::_init_callbacks
0000s0sXML::LibXML::::_parser_options XML::LibXML::_parser_options
0000s0sXML::LibXML::::base_uri XML::LibXML::base_uri
0000s0sXML::LibXML::::callbacks XML::LibXML::callbacks
0000s0sXML::LibXML::::clean_namespaces XML::LibXML::clean_namespaces
0000s0sXML::LibXML::::close_callback XML::LibXML::close_callback
0000s0sXML::LibXML::::complete_attributes XML::LibXML::complete_attributes
0000s0sXML::LibXML::::createDocument XML::LibXML::createDocument
0000s0sXML::LibXML::::expand_entities XML::LibXML::expand_entities
0000s0sXML::LibXML::::expand_xinclude XML::LibXML::expand_xinclude
0000s0sXML::LibXML::::finish_push XML::LibXML::finish_push
0000s0sXML::LibXML::::gdome_dom XML::LibXML::gdome_dom
0000s0sXML::LibXML::::init_push XML::LibXML::init_push
0000s0sXML::LibXML::::input_callbacks XML::LibXML::input_callbacks
0000s0sXML::LibXML::::keep_blanks XML::LibXML::keep_blanks
0000s0sXML::LibXML::::line_numbers XML::LibXML::line_numbers
0000s0sXML::LibXML::::load_ext_dtd XML::LibXML::load_ext_dtd
0000s0sXML::LibXML::::match_callback XML::LibXML::match_callback
0000s0sXML::LibXML::::new XML::LibXML::new
0000s0sXML::LibXML::::no_network XML::LibXML::no_network
0000s0sXML::LibXML::::open_callback XML::LibXML::open_callback
0000s0sXML::LibXML::::parse_balanced_chunk XML::LibXML::parse_balanced_chunk
0000s0sXML::LibXML::::parse_chunk XML::LibXML::parse_chunk
0000s0sXML::LibXML::::parse_fh XML::LibXML::parse_fh
0000s0sXML::LibXML::::parse_file XML::LibXML::parse_file
0000s0sXML::LibXML::::parse_html_fh XML::LibXML::parse_html_fh
0000s0sXML::LibXML::::parse_html_file XML::LibXML::parse_html_file
0000s0sXML::LibXML::::parse_html_string XML::LibXML::parse_html_string
0000s0sXML::LibXML::::parse_string XML::LibXML::parse_string
0000s0sXML::LibXML::::parse_xml_chunk XML::LibXML::parse_xml_chunk
0000s0sXML::LibXML::::pedantic_parser XML::LibXML::pedantic_parser
0000s0sXML::LibXML::::processXIncludes XML::LibXML::processXIncludes
0000s0sXML::LibXML::::process_xincludes XML::LibXML::process_xincludes
0000s0sXML::LibXML::::push XML::LibXML::push
0000s0sXML::LibXML::::read_callback XML::LibXML::read_callback
0000s0sXML::LibXML::::recover XML::LibXML::recover
0000s0sXML::LibXML::::recover_silently XML::LibXML::recover_silently
0000s0sXML::LibXML::::set_handler XML::LibXML::set_handler
0000s0sXML::LibXML::::validation XML::LibXML::validation
LineStmts.Exclusive
Time
Avg.Code
1# $Id: LibXML.pm 709 2008-01-29 21:01:32Z pajas $
2
3package XML::LibXML;
4
5339µs13µsuse strict;
# spent 7µs making 1 call to strict::import
6use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS
# spent 152µs making 1 call to vars::import
7 $skipDTD $skipXMLDeclaration $setTagCompression
8 $MatchCB $ReadCB $OpenCB $CloseCB
9330µs10µs );
10328µs9µsuse Carp;
# spent 58µs making 1 call to Exporter::import
11
123137µs46µsuse XML::LibXML::Common qw(:encoding :libxml);
# spent 360µs making 1 call to Exporter::import
13
14328µs9µsuse constant XML_XMLNS_NS => 'http://www.w3.org/2000/xmlns/';
# spent 48µs making 1 call to constant::import
15323µs8µsuse constant XML_XML_NS => 'http://www.w3.org/XML/1998/namespace';
# spent 45µs making 1 call to constant::import
16
173140µs47µsuse XML::LibXML::NodeList;
# spent 4µs making 1 call to import
183126µs42µsuse XML::LibXML::XPathContext;
# spent 4µs making 1 call to import
193255µs85µsuse IO::Handle; # for FH reads called as methods
# spent 28µs making 1 call to Exporter::import
20
21BEGIN {
22
231694µs6µs$VERSION = "1.66"; # VERSION TEMPLATE: DO NOT CHANGE
24require Exporter;
25require DynaLoader;
26@ISA = qw(DynaLoader Exporter);
27
28#-------------------------------------------------------------------------#
29# export information #
30#-------------------------------------------------------------------------#
31%EXPORT_TAGS = (
32 all => [qw(
33 XML_ELEMENT_NODE
34 XML_ATTRIBUTE_NODE
35 XML_TEXT_NODE
36 XML_CDATA_SECTION_NODE
37 XML_ENTITY_REF_NODE
38 XML_ENTITY_NODE
39 XML_PI_NODE
40 XML_COMMENT_NODE
41 XML_DOCUMENT_NODE
42 XML_DOCUMENT_TYPE_NODE
43 XML_DOCUMENT_FRAG_NODE
44 XML_NOTATION_NODE
45 XML_HTML_DOCUMENT_NODE
46 XML_DTD_NODE
47 XML_ELEMENT_DECL
48 XML_ATTRIBUTE_DECL
49 XML_ENTITY_DECL
50 XML_NAMESPACE_DECL
51 XML_XINCLUDE_END
52 XML_XINCLUDE_START
53 encodeToUTF8
54 decodeFromUTF8
55 XML_XMLNS_NS
56 XML_XML_NS
57 )],
58 libxml => [qw(
59 XML_ELEMENT_NODE
60 XML_ATTRIBUTE_NODE
61 XML_TEXT_NODE
62 XML_CDATA_SECTION_NODE
63 XML_ENTITY_REF_NODE
64 XML_ENTITY_NODE
65 XML_PI_NODE
66 XML_COMMENT_NODE
67 XML_DOCUMENT_NODE
68 XML_DOCUMENT_TYPE_NODE
69 XML_DOCUMENT_FRAG_NODE
70 XML_NOTATION_NODE
71 XML_HTML_DOCUMENT_NODE
72 XML_DTD_NODE
73 XML_ELEMENT_DECL
74 XML_ATTRIBUTE_DECL
75 XML_ENTITY_DECL
76 XML_NAMESPACE_DECL
77 XML_XINCLUDE_END
78 XML_XINCLUDE_START
79 )],
80 encoding => [qw(
81 encodeToUTF8
82 decodeFromUTF8
83 )],
84 ns => [qw(
85 XML_XMLNS_NS
86 XML_XML_NS
87 )],
88 );
89
90@EXPORT_OK = (
91 @{$EXPORT_TAGS{all}},
92 );
93
94@EXPORT = (
95 @{$EXPORT_TAGS{all}},
96 );
97
98#-------------------------------------------------------------------------#
99# initialization of the global variables #
100#-------------------------------------------------------------------------#
101$skipDTD = 0;
102$skipXMLDeclaration = 0;
103$setTagCompression = 0;
104
105$MatchCB = undef;
106$ReadCB = undef;
107$OpenCB = undef;
108$CloseCB = undef;
109
110#-------------------------------------------------------------------------#
111# bootstrapping #
112#-------------------------------------------------------------------------#
113bootstrap XML::LibXML $VERSION;
# spent 1.26ms making 1 call to DynaLoader::bootstrap
114undef &AUTOLOAD;
115
11614.69ms4.69ms} # BEGIN
117
118#-------------------------------------------------------------------------#
119# test exact version (up to patch-level) #
120#-------------------------------------------------------------------------#
121{
122343µs14µs my ($runtime_version) = LIBXML_RUNTIME_VERSION() =~ /^(\d+)/;
# spent 25µs making 1 call to XML::LibXML::LIBXML_RUNTIME_VERSION
123 if ( $runtime_version < LIBXML_VERSION ) {
# spent 10µs making 1 call to XML::LibXML::LIBXML_VERSION
124 warn "Warning: XML::LibXML compiled against libxml2 ".LIBXML_VERSION.
125 ", but runtime libxml2 is older $runtime_version\n";
126 }
127}
128
129#-------------------------------------------------------------------------#
130# parser constructor #
131#-------------------------------------------------------------------------#
132sub new {
133 my $class = shift;
134 my %options = @_;
135 if ( not exists $options{XML_LIBXML_KEEP_BLANKS} ) {
136 $options{XML_LIBXML_KEEP_BLANKS} = 1;
137 }
138
139 if ( defined $options{catalog} ) {
140 $class->load_catalog( $options{catalog} );
141 delete $options{catalog};
142 }
143
144 my $self = bless \%options, $class;
145 if ( defined $options{Handler} ) {
146 $self->set_handler( $options{Handler} );
147 }
148
149 $self->{XML_LIBXML_EXT_DTD} = 1;
150 $self->{_State_} = 0;
151 return $self;
152}
153
154#-------------------------------------------------------------------------#
155# Threads support methods #
156#-------------------------------------------------------------------------#
157
158# threads doc says CLONE's API may change in future, which would break
159# an XS method prototype
160sub CLONE { XML::LibXML::_CLONE( $_[0] ) }
161
162#-------------------------------------------------------------------------#
163# DOM Level 2 document constructor #
164#-------------------------------------------------------------------------#
165
166sub createDocument {
167 my $self = shift;
168 if (!@_ or $_[0] =~ m/^\d\.\d$/) {
169 # for backward compatibility
170 return XML::LibXML::Document->new(@_);
171 }
172 else {
173 # DOM API: createDocument(namespaceURI, qualifiedName, doctype?)
174 my $doc = XML::LibXML::Document-> new;
175 my $el = $doc->createElementNS(shift, shift);
176 $doc->setDocumentElement($el);
177 $doc->setExternalSubset(shift) if @_;
178 return $doc;
179 }
180}
181
182#-------------------------------------------------------------------------#
183# callback functions #
184#-------------------------------------------------------------------------#
185
186sub input_callbacks {
187 my $self = shift;
188 my $icbclass = shift;
189
190 if ( defined $icbclass ) {
191 $self->{XML_LIBXML_CALLBACK_STACK} = $icbclass;
192 }
193 return $self->{XML_LIBXML_CALLBACK_STACK};
194}
195
196sub match_callback {
197 my $self = shift;
198 if ( ref $self ) {
199 if ( scalar @_ ) {
200 $self->{XML_LIBXML_MATCH_CB} = shift;
201 $self->{XML_LIBXML_CALLBACK_STACK} = undef;
202 }
203 return $self->{XML_LIBXML_MATCH_CB};
204 }
205 else {
206 $MatchCB = shift if scalar @_;
207 return $MatchCB;
208 }
209}
210
211sub read_callback {
212 my $self = shift;
213 if ( ref $self ) {
214 if ( scalar @_ ) {
215 $self->{XML_LIBXML_READ_CB} = shift;
216 $self->{XML_LIBXML_CALLBACK_STACK} = undef;
217 }
218 return $self->{XML_LIBXML_READ_CB};
219 }
220 else {
221 $ReadCB = shift if scalar @_;
222 return $ReadCB;
223 }
224}
225
226sub close_callback {
227 my $self = shift;
228 if ( ref $self ) {
229 if ( scalar @_ ) {
230 $self->{XML_LIBXML_CLOSE_CB} = shift;
231 $self->{XML_LIBXML_CALLBACK_STACK} = undef;
232 }
233 return $self->{XML_LIBXML_CLOSE_CB};
234 }
235 else {
236 $CloseCB = shift if scalar @_;
237 return $CloseCB;
238 }
239}
240
241sub open_callback {
242 my $self = shift;
243 if ( ref $self ) {
244 if ( scalar @_ ) {
245 $self->{XML_LIBXML_OPEN_CB} = shift;
246 $self->{XML_LIBXML_CALLBACK_STACK} = undef;
247 }
248 return $self->{XML_LIBXML_OPEN_CB};
249 }
250 else {
251 $OpenCB = shift if scalar @_;
252 return $OpenCB;
253 }
254}
255
256sub callbacks {
257 my $self = shift;
258 if ( ref $self ) {
259 if (@_) {
260 my ($match, $open, $read, $close) = @_;
261 @{$self}{qw(XML_LIBXML_MATCH_CB XML_LIBXML_OPEN_CB XML_LIBXML_READ_CB XML_LIBXML_CLOSE_CB)} = ($match, $open, $read, $close);
262 $self->{XML_LIBXML_CALLBACK_STACK} = undef;
263 }
264 else {
265 return @{$self}{qw(XML_LIBXML_MATCH_CB XML_LIBXML_OPEN_CB XML_LIBXML_READ_CB XML_LIBXML_CLOSE_CB)};
266 }
267 }
268 else {
269 if (@_) {
270 ( $MatchCB, $OpenCB, $ReadCB, $CloseCB ) = @_;
271 }
272 else {
273 return ( $MatchCB, $OpenCB, $ReadCB, $CloseCB );
274 }
275 }
276}
277
278#-------------------------------------------------------------------------#
279# member variable manipulation #
280#-------------------------------------------------------------------------#
281sub validation {
282 my $self = shift;
283 $self->{XML_LIBXML_VALIDATION} = shift if scalar @_;
284 return $self->{XML_LIBXML_VALIDATION};
285}
286
287sub recover {
288 my $self = shift;
289 $self->{XML_LIBXML_RECOVER} = shift if scalar @_;
290 return $self->{XML_LIBXML_RECOVER};
291}
292
293sub recover_silently {
294 my $self = shift;
295 my $arg = shift;
296 (($arg == 1) ? $self->recover(2) : $self->recover($arg)) if defined($arg);
297 return ($self->recover() == 2) ? 1 : 0;
298}
299
300sub expand_entities {
301 my $self = shift;
302 $self->{XML_LIBXML_EXPAND_ENTITIES} = shift if scalar @_;
303 return $self->{XML_LIBXML_EXPAND_ENTITIES};
304}
305
306sub keep_blanks {
307 my $self = shift;
308 $self->{XML_LIBXML_KEEP_BLANKS} = shift if scalar @_;
309 return $self->{XML_LIBXML_KEEP_BLANKS};
310}
311
312sub pedantic_parser {
313 my $self = shift;
314 $self->{XML_LIBXML_PEDANTIC} = shift if scalar @_;
315 return $self->{XML_LIBXML_PEDANTIC};
316}
317
318sub line_numbers {
319 my $self = shift;
320 $self->{XML_LIBXML_LINENUMBERS} = shift if scalar @_;
321 return $self->{XML_LIBXML_LINENUMBERS};
322}
323
324sub no_network {
325 my $self = shift;
326 $self->{XML_LIBXML_NONET} = shift if scalar @_;
327 return $self->{XML_LIBXML_NONET};
328}
329
330sub load_ext_dtd {
331 my $self = shift;
332 $self->{XML_LIBXML_EXT_DTD} = shift if scalar @_;
333 return $self->{XML_LIBXML_EXT_DTD};
334}
335
336sub complete_attributes {
337 my $self = shift;
338 $self->{XML_LIBXML_COMPLETE_ATTR} = shift if scalar @_;
339 return $self->{XML_LIBXML_COMPLETE_ATTR};
340}
341
342sub expand_xinclude {
343 my $self = shift;
344 $self->{XML_LIBXML_EXPAND_XINCLUDE} = shift if scalar @_;
345 return $self->{XML_LIBXML_EXPAND_XINCLUDE};
346}
347
348sub base_uri {
349 my $self = shift;
350 $self->{XML_LIBXML_BASE_URI} = shift if scalar @_;
351 return $self->{XML_LIBXML_BASE_URI};
352}
353
354sub gdome_dom {
355 my $self = shift;
356 $self->{XML_LIBXML_GDOME} = shift if scalar @_;
357 return $self->{XML_LIBXML_GDOME};
358}
359
360sub clean_namespaces {
361 my $self = shift;
362 $self->{XML_LIBXML_NSCLEAN} = shift if scalar @_;
363 return $self->{XML_LIBXML_NSCLEAN};
364}
365
366#-------------------------------------------------------------------------#
367# set the optional SAX(2) handler #
368#-------------------------------------------------------------------------#
369sub set_handler {
370 my $self = shift;
371 if ( defined $_[0] ) {
372 $self->{HANDLER} = $_[0];
373
374 $self->{SAX_ELSTACK} = [];
375 $self->{SAX} = {State => 0};
376 }
377 else {
378 # undef SAX handling
379 $self->{SAX_ELSTACK} = [];
380 delete $self->{HANDLER};
381 delete $self->{SAX};
382 }
383}
384
385#-------------------------------------------------------------------------#
386# helper functions #
387#-------------------------------------------------------------------------#
388sub _auto_expand {
389 my ( $self, $result, $uri ) = @_;
390
391 $result->setBaseURI( $uri ) if defined $uri;
392
393 if ( defined $self->{XML_LIBXML_EXPAND_XINCLUDE}
394 and $self->{XML_LIBXML_EXPAND_XINCLUDE} == 1 ) {
395 $self->{_State_} = 1;
396 eval { $self->processXIncludes($result); };
397 my $err = $@;
398 $self->{_State_} = 0;
399 if ($err) {
400 $self->_cleanup_callbacks();
401 $result = undef;
402 croak $err;
403 }
404 }
405 return $result;
406}
407
408sub _init_callbacks {
409 my $self = shift;
410 my $icb = $self->{XML_LIBXML_CALLBACK_STACK};
411
412 unless ( defined $icb ) {
413 $self->{XML_LIBXML_CALLBACK_STACK} = XML::LibXML::InputCallback->new();
414 $icb = $self->{XML_LIBXML_CALLBACK_STACK};
415 }
416
417 my $mcb = $self->match_callback();
418 my $ocb = $self->open_callback();
419 my $rcb = $self->read_callback();
420 my $ccb = $self->close_callback();
421
422 if ( defined $mcb and defined $ocb and defined $rcb and defined $ccb ) {
423 $icb->register_callbacks( [$mcb, $ocb, $rcb, $ccb] );
424 }
425
426 $icb->init_callbacks();
427}
428
429sub _cleanup_callbacks {
430 my $self = shift;
431 $self->{XML_LIBXML_CALLBACK_STACK}->cleanup_callbacks();
432 my $mcb = $self->match_callback();
433 $self->{XML_LIBXML_CALLBACK_STACK}->unregister_callbacks( [$mcb] );
434}
435
436sub __read {
437 read($_[0], $_[1], $_[2]);
438}
439
440sub __write {
441 if ( ref( $_[0] ) ) {
442 $_[0]->write( $_[1], $_[2] );
443 }
444 else {
445 $_[0]->write( $_[1] );
446 }
447}
448
449# currently this is only used in the XInlcude processor
450# but in the future, all parsing functions should turn to
451# the new libxml2 parsing API internally and this will
452# become handy
453sub _parser_options {
454 my ($self,$opts)=@_;
455 $opts = {} unless ref $opts;
456 my $flags = 0;
457 $flags |= 1 if exists $opts->{recover} ? $opts->{recover} : $self->recover;
458 $flags |= 2 if exists $opts->{expand_entities} ? $opts->{expand_entities} : $self->expand_entities;
459 $flags |= 4 if exists $opts->{load_ext_dtd} ? $opts->{load_ext_dtd} : $self->load_ext_dtd;
460 $flags |= 8 if exists $opts->{complete_attributes} ? $opts->{complete_attributes} : $self->complete_attributes;
461 $flags |= 16 if exists $opts->{validation} ? $opts->{validation} : $self->validation;
462 $flags |= 32 if $opts->{suppress_errors};
463 $flags |= 64 if $opts->{suppress_warnings};
464 $flags |= 128 if exists $opts->{pedantic_parser} ? $opts->{pedantic_parser} : $self->pedantic_parser;
465 $flags |= 256 if exists $opts->{no_blanks} ? $opts->{no_blanks} : !$self->keep_blanks();
466 $flags |= 1024 if exists $opts->{expand_xinclude} ? $opts->{expand_xinclude} : $self->expand_xinclude;
467 $flags |= 2048 if exists $opts->{no_network} ? $opts->{no_network} : $self->no_network;
468 $flags |= 8192 if exists $opts->{clean_namespaces} ? $opts->{clean_namespaces} : $self->clean_namespaces;
469 $flags |= 16384 if $opts->{no_cdata};
470 $flags |= 32768 if $opts->{no_xinclude_nodes};
471 return ($flags);
472}
473
474
475#-------------------------------------------------------------------------#
476# parsing functions #
477#-------------------------------------------------------------------------#
478# all parsing functions handle normal as SAX parsing at the same time.
479# note that SAX parsing is handled incomplete! use XML::LibXML::SAX for
480# complete parsing sequences
481#-------------------------------------------------------------------------#
482sub parse_string {
483 my $self = shift;
484 croak("parse_string is not a class method! Create a parser object with XML::LibXML->new first!") unless ref $self;
485 croak("parse already in progress") if $self->{_State_};
486
487 unless ( defined $_[0] and length $_[0] ) {
488 croak("Empty String");
489 }
490
491 $self->{_State_} = 1;
492 my $result;
493
494 $self->_init_callbacks();
495
496 if ( defined $self->{SAX} ) {
497 my $string = shift;
498 $self->{SAX_ELSTACK} = [];
499
500 eval { $result = $self->_parse_sax_string($string); };
501
502 my $err = $@;
503 $self->{_State_} = 0;
504 if ($err) {
505 chomp $err;
506 $self->_cleanup_callbacks();
507 croak $err;
508 }
509 }
510 else {
511 eval { $result = $self->_parse_string( @_ ); };
512
513 my $err = $@;
514 $self->{_State_} = 0;
515 if ($err) {
516 chomp $err;
517 $self->_cleanup_callbacks();
518 croak $err;
519 }
520
521 $result = $self->_auto_expand( $result, $self->{XML_LIBXML_BASE_URI} );
522 }
523 $self->_cleanup_callbacks();
524
525 return $result;
526}
527
528sub parse_fh {
529 my $self = shift;
530 croak("parse_fh is not a class method! Create a parser object with XML::LibXML->new first!") unless ref $self;
531 croak("parse already in progress") if $self->{_State_};
532 $self->{_State_} = 1;
533 my $result;
534
535 $self->_init_callbacks();
536
537 if ( defined $self->{SAX} ) {
538 $self->{SAX_ELSTACK} = [];
539 eval { $self->_parse_sax_fh( @_ ); };
540 my $err = $@;
541 $self->{_State_} = 0;
542 if ($err) {
543 chomp $err;
544 $self->_cleanup_callbacks();
545 croak $err;
546 }
547 }
548 else {
549 eval { $result = $self->_parse_fh( @_ ); };
550 my $err = $@;
551 $self->{_State_} = 0;
552 if ($err) {
553 chomp $err;
554 $self->_cleanup_callbacks();
555 croak $err;
556 }
557
558 $result = $self->_auto_expand( $result, $self->{XML_LIBXML_BASE_URI} );
559 }
560
561 $self->_cleanup_callbacks();
562
563 return $result;
564}
565
566sub parse_file {
567 my $self = shift;
568 croak("parse_file is not a class method! Create a parser object with XML::LibXML->new first!") unless ref $self;
569 croak("parse already in progress") if $self->{_State_};
570 $self->{_State_} = 1;
571 my $result;
572
573 $self->_init_callbacks();
574
575 if ( defined $self->{SAX} ) {
576 $self->{SAX_ELSTACK} = [];
577 eval { $self->_parse_sax_file( @_ ); };
578 my $err = $@;
579 $self->{_State_} = 0;
580 if ($err) {
581 chomp $err;
582 $self->_cleanup_callbacks();
583 croak $err;
584 }
585 }
586 else {
587 eval { $result = $self->_parse_file(@_); };
588 my $err = $@;
589 $self->{_State_} = 0;
590 if ($err) {
591 chomp $err;
592 $self->_cleanup_callbacks();
593 croak $err;
594 }
595
596 $result = $self->_auto_expand( $result );
597 }
598 $self->_cleanup_callbacks();
599
600 return $result;
601}
602
603sub parse_xml_chunk {
604 my $self = shift;
605 # max 2 parameter:
606 # 1: the chunk
607 # 2: the encoding of the string
608 croak("parse_xml_chunk is not a class method! Create a parser object with XML::LibXML->new first!") unless ref $self;
609 croak("parse already in progress") if $self->{_State_}; my $result;
610
611 unless ( defined $_[0] and length $_[0] ) {
612 croak("Empty String");
613 }
614
615 $self->{_State_} = 1;
616
617 $self->_init_callbacks();
618
619 if ( defined $self->{SAX} ) {
620 eval {
621 $self->_parse_sax_xml_chunk( @_ );
622
623 # this is required for XML::GenericChunk.
624 # in normal case is_filter is not defined, an thus the parsing
625 # will be terminated. in case of a SAX filter the parsing is not
626 # finished at that state. therefore we must not reset the parsing
627 unless ( $self->{IS_FILTER} ) {
628 $result = $self->{HANDLER}->end_document();
629 }
630 };
631 }
632 else {
633 eval { $result = $self->_parse_xml_chunk( @_ ); };
634 }
635
636 $self->_cleanup_callbacks();
637
638 my $err = $@;
639 $self->{_State_} = 0;
640 if ($err) {
641 chomp $err;
642 croak $err;
643 }
644
645 return $result;
646}
647
648sub parse_balanced_chunk {
649 my $self = shift;
650 $self->_init_callbacks();
651 my $rv;
652 eval {
653 $rv = $self->parse_xml_chunk( @_ );
654 };
655 my $err = $@;
656 $self->_cleanup_callbacks();
657 if ( $err ) {
658 chomp $err;
659 croak $err;
660 }
661 return $rv
662}
663
664# java style
665sub processXIncludes {
666 my $self = shift;
667 my $doc = shift;
668 my $opts = shift;
669 my $options = $self->_parser_options($opts);
670 if ( $self->{_State_} != 1 ) {
671 $self->_init_callbacks();
672 }
673 my $rv;
674 eval {
675 $rv = $self->_processXIncludes($doc || " ", $options);
676 };
677 my $err = $@;
678 if ( $self->{_State_} != 1 ) {
679 $self->_cleanup_callbacks();
680 }
681
682 if ( $err ) {
683 chomp $err;
684 croak $err;
685 }
686 return $rv;
687}
688
689# perl style
690sub process_xincludes {
691 my $self = shift;
692 my $doc = shift;
693 my $opts = shift;
694 my $options = $self->_parser_options($opts);
695
696 my $rv;
697 $self->_init_callbacks();
698 eval {
699 $rv = $self->_processXIncludes($doc || " ", $options);
700 };
701 my $err = $@;
702 $self->_cleanup_callbacks();
703 if ( $err ) {
704 chomp $err;
705 croak $@;
706 }
707 return $rv;
708}
709
710#-------------------------------------------------------------------------#
711# HTML parsing functions #
712#-------------------------------------------------------------------------#
713
714sub _html_options {
715 my ($self,$opts)=@_;
716 $opts = {} unless ref $opts;
717 # return (undef,undef) unless ref $opts;
718 my $flags = 0;
719 $flags |= 1 if exists $opts->{recover} ? $opts->{recover} : $self->recover;
720 $flags |= 32 if $opts->{suppress_errors};
721 $flags |= 64 if $opts->{suppress_warnings};
722 $flags |= 128 if exists $opts->{pedantic_parser} ? $opts->{pedantic_parser} : $self->pedantic_parser;
723 $flags |= 256 if exists $opts->{no_blanks} ? $opts->{no_blanks} : !$self->keep_blanks;
724 $flags |= 2048 if exists $opts->{no_network} ? $opts->{no_network} : !$self->no_network;
725 return ($opts->{URI},$opts->{encoding},$flags);
726}
727
728sub parse_html_string {
729 my ($self,$str,$opts) = @_;
730 croak("parse_html_string is not a class method! Create a parser object with XML::LibXML->new first!") unless ref $self;
731 croak("parse already in progress") if $self->{_State_};
732
733 unless ( defined $str and length $str ) {
734 croak("Empty String");
735 }
736 $self->{_State_} = 1;
737 my $result;
738
739 $self->_init_callbacks();
740 eval {
741 $result = $self->_parse_html_string( $str,
742 $self->_html_options($opts)
743 );
744 };
745 my $err = $@;
746 $self->{_State_} = 0;
747 if ($err) {
748 chomp $err;
749 $self->_cleanup_callbacks();
750 croak $err;
751 }
752
753 $self->_cleanup_callbacks();
754
755 return $result;
756}
757
758sub parse_html_file {
759 my ($self,$file,$opts) = @_;
760 croak("parse_html_file is not a class method! Create a parser object with XML::LibXML->new first!") unless ref $self;
761 croak("parse already in progress") if $self->{_State_};
762 $self->{_State_} = 1;
763 my $result;
764
765 $self->_init_callbacks();
766 eval { $result = $self->_parse_html_file($file,
767 $self->_html_options($opts)
768 ); };
769 my $err = $@;
770 $self->{_State_} = 0;
771 if ($err) {
772 chomp $err;
773 $self->_cleanup_callbacks();
774 croak $err;
775 }
776
777 $self->_cleanup_callbacks();
778
779 return $result;
780}
781
782sub parse_html_fh {
783 my ($self,$fh,$opts) = @_;
784 croak("parse_html_fh is not a class method! Create a parser object with XML::LibXML->new first!") unless ref $self;
785 croak("parse already in progress") if $self->{_State_};
786 $self->{_State_} = 1;
787
788 my $result;
789 $self->_init_callbacks();
790 eval { $result = $self->_parse_html_fh( $fh,
791 $self->_html_options($opts)
792 ); };
793 my $err = $@;
794 $self->{_State_} = 0;
795 if ($err) {
796 chomp $err;
797 $self->_cleanup_callbacks();
798 croak $err;
799 }
800 $self->_cleanup_callbacks();
801
802 return $result;
803}
804
805#-------------------------------------------------------------------------#
806# push parser interface #
807#-------------------------------------------------------------------------#
808sub init_push {
809 my $self = shift;
810
811 if ( defined $self->{CONTEXT} ) {
812 delete $self->{CONTEXT};
813 }
814
815 if ( defined $self->{SAX} ) {
816 $self->{CONTEXT} = $self->_start_push(1);
817 }
818 else {
819 $self->{CONTEXT} = $self->_start_push(0);
820 }
821}
822
823sub push {
824 my $self = shift;
825
826 $self->_init_callbacks();
827
828 if ( not defined $self->{CONTEXT} ) {
829 $self->init_push();
830 }
831
832 eval {
833 foreach ( @_ ) {
834 $self->_push( $self->{CONTEXT}, $_ );
835 }
836 };
837 my $err = $@;
838 $self->_cleanup_callbacks();
839 if ( $err ) {
840 chomp $err;
841 croak $err;
842 }
843}
844
845# this function should be promoted!
846# the reason is because libxml2 uses xmlParseChunk() for this purpose!
847sub parse_chunk {
848 my $self = shift;
849 my $chunk = shift;
850 my $terminate = shift;
851
852 if ( not defined $self->{CONTEXT} ) {
853 $self->init_push();
854 }
855
856 if ( defined $chunk and length $chunk ) {
857 $self->_push( $self->{CONTEXT}, $chunk );
858 }
859
860 if ( $terminate ) {
861 return $self->finish_push();
862 }
863}
864
865
866sub finish_push {
867 my $self = shift;
868 my $restore = shift || 0;
869 return undef unless defined $self->{CONTEXT};
870
871 my $retval;
872
873 if ( defined $self->{SAX} ) {
874 eval {
875 $self->_end_sax_push( $self->{CONTEXT} );
876 $retval = $self->{HANDLER}->end_document( {} );
877 };
878 }
879 else {
880 eval { $retval = $self->_end_push( $self->{CONTEXT}, $restore ); };
881 }
882 delete $self->{CONTEXT};
883 my $err = $@;
884 if ( $err ) {
885 chomp $err;
886 croak( $err );
887 }
888 return $retval;
889}
890
8911100ns100ns1;
892
893#-------------------------------------------------------------------------#
894# XML::LibXML::Node Interface #
895#-------------------------------------------------------------------------#
896package XML::LibXML::Node;
897
898sub isSupported {
899 my $self = shift;
900 my $feature = shift;
901 return $self->can($feature) ? 1 : 0;
902}
903
904sub getChildNodes { my $self = shift; return $self->childNodes(); }
905
906sub childNodes {
907 my $self = shift;
908 my @children = $self->_childNodes();
909 return wantarray ? @children : XML::LibXML::NodeList->new_from_ref(\@children , 1);
910}
911
912sub attributes {
913 my $self = shift;
914 my @attr = $self->_attributes();
915 return wantarray ? @attr : XML::LibXML::NamedNodeMap->new( @attr );
916}
917
918
919sub findnodes {
920 my ($node, $xpath) = @_;
921 my @nodes = $node->_findnodes($xpath);
922 if (wantarray) {
923 return @nodes;
924 }
925 else {
926 return XML::LibXML::NodeList->new_from_ref(\@nodes, 1);
927 }
928}
929
930sub findvalue {
931 my ($node, $xpath) = @_;
932 my $res;
933 eval {
934 $res = $node->find($xpath);
935 };
936 if ( $@ ) {
937 die $@;
938 }
939 return $res->to_literal->value;
940}
941
942sub find {
943 my ($node, $xpath) = @_;
944 my ($type, @params) = $node->_find($xpath);
945 if ($type) {
946 return $type->new(@params);
947 }
948 return undef;
949}
950
951sub setOwnerDocument {
952 my ( $self, $doc ) = @_;
953 $doc->adoptNode( $self );
954}
955
956sub toStringC14N {
957 my ($self, $comments, $xpath) = (shift, shift, shift);
958 return $self->_toStringC14N( $comments || 0,
959 (defined $xpath ? $xpath : undef),
960 0,
961 undef );
962}
963sub toStringEC14N {
964 my ($self, $comments, $xpath, $inc_prefix_list) = @_;
965 if (defined($inc_prefix_list) and !UNIVERSAL::isa($inc_prefix_list,'ARRAY')) {
966 croak("toStringEC14N: inclusive_prefix_list must be undefined or ARRAY");
967 }
968 return $self->_toStringC14N( $comments || 0,
969 (defined $xpath ? $xpath : undef),
970 1,
971 (defined $inc_prefix_list ? $inc_prefix_list : undef));
972}
973
97413µs3µs*serialize_c14n = \&toStringC14N;
9751900ns900ns*serialize_exc_c14n = \&toStringEC14N;
976
9771100ns100ns1;
978
979#-------------------------------------------------------------------------#
980# XML::LibXML::Document Interface #
981#-------------------------------------------------------------------------#
982package XML::LibXML::Document;
983
9843543µs181µsuse vars qw(@ISA);
# spent 37µs making 1 call to vars::import
985110µs10µs@ISA = ('XML::LibXML::Node');
986
987sub actualEncoding {
988 my $doc = shift;
989 my $enc = $doc->encoding;
990 return (defined $enc and length $enc) ? $enc : 'UTF-8';
991}
992
993sub setDocumentElement {
994 my $doc = shift;
995 my $element = shift;
996
997 my $oldelem = $doc->documentElement;
998 if ( defined $oldelem ) {
999 $doc->removeChild($oldelem);
1000 }
1001
1002 $doc->_setDocumentElement($element);
1003}
1004
1005sub toString {
1006 my $self = shift;
1007 my $flag = shift;
1008
1009 my $retval = "";
1010
1011 if ( defined $XML::LibXML::skipXMLDeclaration
1012 and $XML::LibXML::skipXMLDeclaration == 1 ) {
1013 foreach ( $self->childNodes ){
1014 next if $_->nodeType == XML::LibXML::XML_DTD_NODE()
1015 and $XML::LibXML::skipDTD;
1016 $retval .= $_->toString;
1017 }
1018 }
1019 else {
1020 $flag ||= 0 unless defined $flag;
1021 $retval = $self->_toString($flag);
1022 }
1023
1024 return $retval;
1025}
1026
1027sub serialize {
1028 my $self = shift;
1029 return $self->toString( @_ );
1030}
1031
1032#-------------------------------------------------------------------------#
1033# bad style xinclude processing #
1034#-------------------------------------------------------------------------#
1035sub process_xinclude {
1036 my $self = shift;
1037 my $opts = shift;
1038 XML::LibXML->new->processXIncludes( $self, $opts );
1039}
1040
1041sub insertProcessingInstruction {
1042 my $self = shift;
1043 my $target = shift;
1044 my $data = shift;
1045
1046 my $pi = $self->createPI( $target, $data );
1047 my $root = $self->documentElement;
1048
1049 if ( defined $root ) {
1050 # this is actually not correct, but i guess it's what the user
1051 # intends
1052 $self->insertBefore( $pi, $root );
1053 }
1054 else {
1055 # if no documentElement was found we just append the PI
1056 $self->appendChild( $pi );
1057 }
1058}
1059
1060sub insertPI {
1061 my $self = shift;
1062 $self->insertProcessingInstruction( @_ );
1063}
1064
1065#-------------------------------------------------------------------------#
1066# DOM L3 Document functions.
1067# added after robins implicit feature requst
1068#-------------------------------------------------------------------------#
106911µs1µs*getElementsByTagName = \&XML::LibXML::Element::getElementsByTagName;
10701800ns800ns*getElementsByTagNameNS = \&XML::LibXML::Element::getElementsByTagNameNS;
10711800ns800ns*getElementsByLocalName = \&XML::LibXML::Element::getElementsByLocalName;
1072
10731100ns100ns1;
1074
1075#-------------------------------------------------------------------------#
1076# XML::LibXML::DocumentFragment Interface #
1077#-------------------------------------------------------------------------#
1078package XML::LibXML::DocumentFragment;
1079
10803119µs40µsuse vars qw(@ISA);
# spent 22µs making 1 call to vars::import
1081119µs19µs@ISA = ('XML::LibXML::Node');
1082
1083sub toString {
1084 my $self = shift;
1085 my $retval = "";
1086 if ( $self->hasChildNodes() ) {
1087 foreach my $n ( $self->childNodes() ) {
1088 $retval .= $n->toString(@_);
1089 }
1090 }
1091 return $retval;
1092}
1093
109411µs1µs*serialize = \&toString;
1095
10961200ns200ns1;
1097
1098#-------------------------------------------------------------------------#
1099# XML::LibXML::Element Interface #
1100#-------------------------------------------------------------------------#
1101package XML::LibXML::Element;
1102
1103341µs14µsuse vars qw(@ISA);
# spent 28µs making 1 call to vars::import
110415µs5µs@ISA = ('XML::LibXML::Node');
1105332µs10µsuse XML::LibXML qw(:ns :libxml);
# spent 326µs making 1 call to Exporter::import
110631.27ms423µsuse Carp;
# spent 56µs making 1 call to Exporter::import
1107
1108sub setNamespace {
1109 my $self = shift;
1110 my $n = $self->nodeName;
1111 if ( $self->_setNamespace(@_) ){
1112 if ( scalar @_ < 3 || $_[2] == 1 ){
1113 $self->setNodeName( $n );
1114 }
1115 return 1;
1116 }
1117 return 0;
1118}
1119
1120sub getAttribute {
1121 my $self = shift;
1122 my $name = $_[0];
1123 if ( $name =~ /^xmlns(?::|$)/ ) {
1124 # user wants to get a namespace ...
1125 (my $prefix = $name )=~s/^xmlns:?//;
1126 $self->_getNamespaceDeclURI($prefix);
1127 }
1128 else {
1129 $self->_getAttribute(@_);
1130 }
1131}
1132
1133sub setAttribute {
1134 my ( $self, $name, $value ) = @_;
1135 if ( $name =~ /^xmlns(?::|$)/ ) {
1136 # user wants to set the special attribute for declaring XML namespace ...
1137
1138 # this is fine but not exactly DOM conformant behavior, btw (according to DOM we should
1139 # probably declare an attribute which looks like XML namespace declaration
1140 # but isn't)
1141 (my $nsprefix = $name )=~s/^xmlns:?//;
1142 my $nn = $self->nodeName;
1143 if ( $nn =~ /^\Q${nsprefix}\E:/ ) {
1144 # the element has the same prefix
1145 $self->setNamespaceDeclURI($nsprefix,$value) ||
1146 $self->setNamespace($value,$nsprefix,1);
1147 ##
1148 ## We set the namespace here.
1149 ## This is helpful, as in:
1150 ##
1151 ## | $e = XML::LibXML::Element->new('foo:bar');
1152 ## | $e->setAttribute('xmlns:foo','http://yoyodine')
1153 ##
1154 }
1155 else {
1156 # just modify the namespace
1157 $self->setNamespaceDeclURI($nsprefix, $value) ||
1158 $self->setNamespace($value,$nsprefix,0);
1159 }
1160 }
1161 else {
1162 $self->_setAttribute($name, $value);
1163 }
1164}
1165
1166sub getAttributeNS {
1167 my $self = shift;
1168 my ($nsURI, $name) = @_;
1169 croak("invalid attribute name") if !defined($name) or $name eq q{};
1170 if ( defined($nsURI) and $nsURI eq XML_XMLNS_NS ) {
1171 $self->_getNamespaceDeclURI($name eq 'xmlns' ? undef : $name);
1172 }
1173 else {
1174 $self->_getAttributeNS(@_);
1175 }
1176}
1177
1178sub setAttributeNS {
1179 my ($self, $nsURI, $qname, $value)=@_;
1180 unless (defined $qname and length $qname) {
1181 croak("bad name");
1182 }
1183 if (defined($nsURI) and $nsURI eq XML_XMLNS_NS) {
1184 if ($qname !~ /^xmlns(?::|$)/) {
1185 croak("NAMESPACE ERROR: Namespace declartions must have the prefix 'xmlns'");
1186 }
1187 $self->setAttribute($qname,$value); # see implementation above
1188 return;
1189 }
1190 if ($qname=~/:/ and not (defined($nsURI) and length($nsURI))) {
1191 croak("NAMESPACE ERROR: Attribute without a prefix cannot be in a namespace");
1192 }
1193 if ($qname=~/^xmlns(?:$|:)/) {
1194 croak("NAMESPACE ERROR: 'xmlns' prefix and qualified-name are reserved for the namespace ".XML_XMLNS_NS);
1195 }
1196 if ($qname=~/^xml:/ and not (defined $nsURI and $nsURI eq XML_XML_NS)) {
1197 croak("NAMESPACE ERROR: 'xml' prefix is reserved for the namespace ".XML_XML_NS);
1198 }
1199 $self->_setAttributeNS( defined $nsURI ? $nsURI : undef, $qname, $value );
1200}
1201
1202sub getElementsByTagName {
1203 my ( $node , $name ) = @_;
1204 my $xpath = $name eq '*' ? "descendant::*" : "descendant::*[name()='$name']";
1205 my @nodes = $node->_findnodes($xpath);
1206 return wantarray ? @nodes : XML::LibXML::NodeList->new_from_ref(\@nodes, 1);
1207}
1208
1209sub getElementsByTagNameNS {
1210 my ( $node, $nsURI, $name ) = @_;
1211 my $xpath;
1212 if ( $name eq '*' ) {
1213 if ( $nsURI eq '*' ) {
1214 $xpath = "descendant::*";
1215 } else {
1216 $xpath = "descendant::*[namespace-uri()='$nsURI']";
1217 }
1218 } elsif ( $nsURI eq '*' ) {
1219 $xpath = "descendant::*[local-name()='$name']";
1220 } else {
1221 $xpath = "descendant::*[local-name()='$name' and namespace-uri()='$nsURI']";
1222 }
1223 my @nodes = $node->_findnodes($xpath);
1224 return wantarray ? @nodes : XML::LibXML::NodeList->new_from_ref(\@nodes, 1);
1225}
1226
1227sub getElementsByLocalName {
1228 my ( $node,$name ) = @_;
1229 my $xpath;
1230 if ($name eq '*') {
1231 $xpath = "descendant::*";
1232 } else {
1233 $xpath = "descendant::*[local-name()='$name']";
1234 }
1235 my @nodes = $node->_findnodes($xpath);
1236 return wantarray ? @nodes : XML::LibXML::NodeList->new_from_ref(\@nodes, 1);
1237}
1238
1239sub getChildrenByTagName {
1240 my ( $node, $name ) = @_;
1241 my @nodes;
1242 if ($name eq '*') {
1243 @nodes = grep { $_->nodeType == XML_ELEMENT_NODE() }
1244 $node->childNodes();
1245 } else {
1246 @nodes = grep { $_->nodeName eq $name } $node->childNodes();
1247 }
1248 return wantarray ? @nodes : XML::LibXML::NodeList->new_from_ref(\@nodes, 1);
1249}
1250
1251sub getChildrenByLocalName {
1252 my ( $node, $name ) = @_;
1253 my @nodes;
1254 if ($name eq '*') {
1255 @nodes = grep { $_->nodeType == XML_ELEMENT_NODE() }
1256 $node->childNodes();
1257 } else {
1258 @nodes = grep { $_->nodeType == XML_ELEMENT_NODE() and
1259 $_->localName eq $name } $node->childNodes();
1260 }
1261 return wantarray ? @nodes : XML::LibXML::NodeList->new_from_ref(\@nodes, 1);
1262}
1263
1264sub getChildrenByTagNameNS {
1265 my ( $node, $nsURI, $name ) = @_;
1266 my @nodes = $node->_getChildrenByTagNameNS($nsURI,$name);
1267 return wantarray ? @nodes : XML::LibXML::NodeList->new_from_ref(\@nodes, 1);
1268}
1269
1270sub appendWellBalancedChunk {
1271 my ( $self, $chunk ) = @_;
1272
1273 my $local_parser = XML::LibXML->new();
1274 my $frag = $local_parser->parse_xml_chunk( $chunk );
1275
1276 $self->appendChild( $frag );
1277}
1278
12791200ns200ns1;
1280
1281#-------------------------------------------------------------------------#
1282# XML::LibXML::Text Interface #
1283#-------------------------------------------------------------------------#
1284package XML::LibXML::Text;
1285
12863376µs125µsuse vars qw(@ISA);
# spent 27µs making 1 call to vars::import
128717µs7µs@ISA = ('XML::LibXML::Node');
1288
1289sub attributes { return undef; }
1290
1291sub deleteDataString {
1292 my $node = shift;
1293 my $string = shift;
1294 my $all = shift;
1295 my $data = $node->nodeValue();
1296 $string =~ s/([\\\*\+\^\{\}\&\?\[\]\(\)\$\%\@])/\\$1/g;
1297 if ( $all ) {
1298 $data =~ s/$string//g;
1299 }
1300 else {
1301 $data =~ s/$string//;
1302 }
1303 $node->setData( $data );
1304}
1305
1306sub replaceDataString {
1307 my ( $node, $left, $right,$all ) = @_;
1308
1309 #ashure we exchange the strings and not expressions!
1310 $left =~ s/([\\\*\+\^\{\}\&\?\[\]\(\)\$\%\@])/\\$1/g;
1311 my $datastr = $node->nodeValue();
1312 if ( $all ) {
1313 $datastr =~ s/$left/$right/g;
1314 }
1315 else{
1316 $datastr =~ s/$left/$right/;
1317 }
1318 $node->setData( $datastr );
1319}
1320
1321sub replaceDataRegEx {
1322 my ( $node, $leftre, $rightre, $flags ) = @_;
1323 return unless defined $leftre;
1324 $rightre ||= "";
1325
1326 my $datastr = $node->nodeValue();
1327 my $restr = "s/" . $leftre . "/" . $rightre . "/";
1328 $restr .= $flags if defined $flags;
1329
1330 eval '$datastr =~ '. $restr;
1331
1332 $node->setData( $datastr );
1333}
1334
13351100ns100ns1;
1336
1337package XML::LibXML::Comment;
1338
1339346µs15µsuse vars qw(@ISA);
# spent 27µs making 1 call to vars::import
134015µs5µs@ISA = ('XML::LibXML::Text');
1341
13421200ns200ns1;
1343
1344package XML::LibXML::CDATASection;
1345
1346342µs14µsuse vars qw(@ISA);
# spent 19µs making 1 call to vars::import
134714µs4µs@ISA = ('XML::LibXML::Text');
1348
13491200ns200ns1;
1350
1351#-------------------------------------------------------------------------#
1352# XML::LibXML::Attribute Interface #
1353#-------------------------------------------------------------------------#
1354package XML::LibXML::Attr;
13553110µs37µsuse vars qw( @ISA ) ;
# spent 22µs making 1 call to vars::import
135618µs8µs@ISA = ('XML::LibXML::Node') ;
1357
1358sub setNamespace {
1359 my ($self,$href,$prefix) = @_;
1360 my $n = $self->nodeName;
1361 if ( $self->_setNamespace($href,$prefix) ) {
1362 $self->setNodeName($n);
1363 return 1;
1364 }
1365
1366 return 0;
1367}
1368
13691200ns200ns1;
1370
1371#-------------------------------------------------------------------------#
1372# XML::LibXML::Dtd Interface #
1373#-------------------------------------------------------------------------#
1374# this is still under construction
1375#
1376package XML::LibXML::Dtd;
1377346µs15µsuse vars qw( @ISA );
# spent 32µs making 1 call to vars::import
137814µs4µs@ISA = ('XML::LibXML::Node');
1379
13801200ns200ns1;
1381
1382#-------------------------------------------------------------------------#
1383# XML::LibXML::PI Interface #
1384#-------------------------------------------------------------------------#
1385package XML::LibXML::PI;
13863426µs142µsuse vars qw( @ISA );
# spent 26µs making 1 call to vars::import
138713µs3µs@ISA = ('XML::LibXML::Node');
1388
1389sub setData {
1390 my $pi = shift;
1391
1392 my $string = "";
1393 if ( scalar @_ == 1 ) {
1394 $string = shift;
1395 }
1396 else {
1397 my %h = @_;
1398 $string = join " ", map {$_.'="'.$h{$_}.'"'} keys %h;
1399 }
1400
1401 # the spec says any char but "?>" [17]
1402 $pi->_setData( $string ) unless $string =~ /\?>/;
1403}
1404
14051200ns200ns1;
1406
1407#-------------------------------------------------------------------------#
1408# XML::LibXML::Namespace Interface #
1409#-------------------------------------------------------------------------#
1410package XML::LibXML::Namespace;
1411
1412# this is infact not a node!
1413sub prefix { return "xmlns"; }
1414sub getPrefix { return "xmlns"; }
1415sub getNamespaceURI { return "http://www.w3.org/2000/xmlns/" };
1416
1417sub getNamespaces { return (); }
1418
1419sub nodeName {
1420 my $self = shift;
1421 my $nsP = $self->localname;
1422 return ( defined($nsP) && length($nsP) ) ? "xmlns:$nsP" : "xmlns";
1423}
1424sub name { goto &nodeName }
1425sub getName { goto &nodeName }
1426
1427sub isEqualNode {
1428 my ( $self, $ref ) = @_;
1429 if ( ref($ref) eq "XML::LibXML::Namespace" ) {
1430 return $self->_isEqual($ref);
1431 }
1432 return 0;
1433}
1434
1435sub isSameNode {
1436 my ( $self, $ref ) = @_;
1437 if ( $$self == $$ref ){
1438 return 1;
1439 }
1440 return 0;
1441}
1442
14431200ns200ns1;
1444
1445#-------------------------------------------------------------------------#
1446# XML::LibXML::NamedNodeMap Interface #
1447#-------------------------------------------------------------------------#
1448package XML::LibXML::NamedNodeMap;
1449
14503686µs229µsuse XML::LibXML::Common qw(:libxml);
# spent 249µs making 1 call to Exporter::import
1451
1452sub new {
1453 my $class = shift;
1454 my $self = bless { Nodes => [@_] }, $class;
1455 $self->{NodeMap} = { map { $_->nodeName => $_ } @_ };
1456 return $self;
1457}
1458
1459sub length { return scalar( @{$_[0]->{Nodes}} ); }
1460sub nodes { return $_[0]->{Nodes}; }
1461sub item { $_[0]->{Nodes}->[$_[1]]; }
1462
1463sub getNamedItem {
1464 my $self = shift;
1465 my $name = shift;
1466
1467 return $self->{NodeMap}->{$name};
1468}
1469
1470sub setNamedItem {
1471 my $self = shift;
1472 my $node = shift;
1473
1474 my $retval;
1475 if ( defined $node ) {
1476 if ( scalar @{$self->{Nodes}} ) {
1477 my $name = $node->nodeName();
1478 if ( $node->nodeType() == XML_NAMESPACE_DECL ) {
1479 return;
1480 }
1481 if ( defined $self->{NodeMap}->{$name} ) {
1482 if ( $node->isSameNode( $self->{NodeMap}->{$name} ) ) {
1483 return;
1484 }
1485 $retval = $self->{NodeMap}->{$name}->replaceNode( $node );
1486 }
1487 else {
1488 $self->{Nodes}->[0]->addSibling($node);
1489 }
1490
1491 $self->{NodeMap}->{$name} = $node;
1492 push @{$self->{Nodes}}, $node;
1493 }
1494 else {
1495 # not done yet
1496 # can this be properly be done???
1497 warn "not done yet\n";
1498 }
1499 }
1500 return $retval;
1501}
1502
1503sub removeNamedItem {
1504 my $self = shift;
1505 my $name = shift;
1506 my $retval;
1507 if ( $name =~ /^xmlns/ ) {
1508 warn "not done yet\n";
1509 }
1510 elsif ( exists $self->{NodeMap}->{$name} ) {
1511 $retval = $self->{NodeMap}->{$name};
1512 $retval->unbindNode;
1513 delete $self->{NodeMap}->{$name};
1514 $self->{Nodes} = [grep {not($retval->isSameNode($_))} @{$self->{Nodes}}];
1515 }
1516
1517 return $retval;
1518}
1519
1520sub getNamedItemNS {
1521 my $self = shift;
1522 my $nsURI = shift;
1523 my $name = shift;
1524 return undef;
1525}
1526
1527sub setNamedItemNS {
1528 my $self = shift;
1529 my $nsURI = shift;
1530 my $node = shift;
1531 return undef;
1532}
1533
1534sub removeNamedItemNS {
1535 my $self = shift;
1536 my $nsURI = shift;
1537 my $name = shift;
1538 return undef;
1539}
1540
15411100ns100ns1;
1542
1543package XML::LibXML::_SAXParser;
1544
1545# this is pseudo class!!! and it will be removed as soon all functions
1546# moved to XS level
1547
15483410µs137µsuse XML::SAX::Exception;
# spent 6µs making 1 call to import
1549
1550# these functions will use SAX exceptions as soon i know how things really work
1551sub warning {
1552 my ( $parser, $message, $line, $col ) = @_;
1553 my $error = XML::SAX::Exception::Parse->new( LineNumber => $line,
1554 ColumnNumber => $col,
1555 Message => $message, );
1556 $parser->{HANDLER}->warning( $error );
1557}
1558
1559sub error {
1560 my ( $parser, $message, $line, $col ) = @_;
1561
1562 my $error = XML::SAX::Exception::Parse->new( LineNumber => $line,
1563 ColumnNumber => $col,
1564 Message => $message, );
1565 $parser->{HANDLER}->error( $error );
1566}
1567
1568sub fatal_error {
1569 my ( $parser, $message, $line, $col ) = @_;
1570 my $error = XML::SAX::Exception::Parse->new( LineNumber => $line,
1571 ColumnNumber => $col,
1572 Message => $message, );
1573 $parser->{HANDLER}->fatal_error( $error );
1574}
1575
15761200ns200ns1;
1577
1578package XML::LibXML::RelaxNG;
1579
1580sub new {
1581 my $class = shift;
1582 my %args = @_;
1583
1584 my $self = undef;
1585 if ( defined $args{location} ) {
1586 $self = $class->parse_location( $args{location} );
1587 }
1588 elsif ( defined $args{string} ) {
1589 $self = $class->parse_buffer( $args{string} );
1590 }
1591 elsif ( defined $args{DOM} ) {
1592 $self = $class->parse_document( $args{DOM} );
1593 }
1594
1595 return $self;
1596}
1597
15981100ns100ns1;
1599
1600package XML::LibXML::Schema;
1601
1602sub new {
1603 my $class = shift;
1604 my %args = @_;
1605
1606 my $self = undef;
1607 if ( defined $args{location} ) {
1608 $self = $class->parse_location( $args{location} );
1609 }
1610 elsif ( defined $args{string} ) {
1611 $self = $class->parse_buffer( $args{string} );
1612 }
1613
1614 return $self;
1615}
1616
16171200ns200ns1;
1618
1619#-------------------------------------------------------------------------#
1620# XML::LibXML::InputCallback Interface #
1621#-------------------------------------------------------------------------#
1622package XML::LibXML::InputCallback;
1623
16243739µs246µsuse vars qw($_CUR_CB @_GLOBAL_CALLBACKS @_CB_STACK);
# spent 54µs making 1 call to vars::import
1625
16261400ns400ns$_CUR_CB = undef;
1627
16281400ns400ns@_GLOBAL_CALLBACKS = ();
16291300ns300ns@_CB_STACK = ();
1630
1631#-------------------------------------------------------------------------#
1632# global callbacks #
1633#-------------------------------------------------------------------------#
1634sub _callback_match {
1635 my $uri = shift;
1636 my $retval = 0;
1637
1638 # loop through the callbacks and and find the first matching
1639 # The callbacks are stored in execution order (reverse stack order)
1640 # any new global callbacks are shifted to the callback stack.
1641 foreach my $cb ( @_GLOBAL_CALLBACKS ) {
1642
1643 # callbacks have to return 1, 0 or undef, while 0 and undef
1644 # are handled the same way.
1645 # in fact, if callbacks return other values, the global match
1646 # assumes silently that the callback failed.
1647
1648 $retval = $cb->[0]->($uri);
1649
1650 if ( defined $retval and $retval == 1 ) {
1651 # make the other callbacks use this callback
1652 $_CUR_CB = $cb;
1653 unshift @_CB_STACK, $cb;
1654 last;
1655 }
1656 }
1657
1658 return $retval;
1659}
1660
1661sub _callback_open {
1662 my $uri = shift;
1663 my $retval = undef;
1664
1665 # the open callback has to return a defined value.
1666 # if one works on files this can be a file handle. But
1667 # depending on the needs of the callback it also can be a
1668 # database handle or a integer labeling a certain dataset.
1669
1670 if ( defined $_CUR_CB ) {
1671 $retval = $_CUR_CB->[1]->( $uri );
1672
1673 # reset the callbacks, if one callback cannot open an uri
1674 if ( not defined $retval or $retval == 0 ) {
1675 shift @_CB_STACK;
1676 $_CUR_CB = $_CB_STACK[0];
1677 }
1678 }
1679
1680 return $retval;
1681}
1682
1683sub _callback_read {
1684 my $fh = shift;
1685 my $buflen = shift;
1686
1687 my $retval = undef;
1688
1689 if ( defined $_CUR_CB ) {
1690 $retval = $_CUR_CB->[2]->( $fh, $buflen );
1691 }
1692
1693 return $retval;
1694}
1695
1696sub _callback_close {
1697 my $fh = shift;
1698 my $retval = 0;
1699
1700 if ( defined $_CUR_CB ) {
1701 $retval = $_CUR_CB->[3]->( $fh );
1702 shift @_CB_STACK;
1703 $_CUR_CB = $_CB_STACK[0];
1704 }
1705
1706 return $retval;
1707}
1708
1709#-------------------------------------------------------------------------#
1710# member functions and methods #
1711#-------------------------------------------------------------------------#
1712
1713sub new {
1714 my $CLASS = shift;
1715 return bless {'_CALLBACKS' => []}, $CLASS;
1716}
1717
1718# add a callback set to the callback stack
1719# synopsis: $icb->register_callbacks( [$match_cb, $open_cb, $read_cb, $close_cb] );
1720sub register_callbacks {
1721 my $self = shift;
1722 my $cbset = shift;
1723
1724 # test if callback set is complete
1725 if ( ref $cbset eq "ARRAY" and scalar( @$cbset ) == 4 ) {
1726 unshift @{$self->{_CALLBACKS}}, $cbset;
1727 }
1728}
1729
1730# remove a callback set to the callback stack
1731# if a callback set is passed, this function will check for the match function
1732sub unregister_callbacks {
1733 my $self = shift;
1734 my $cbset = shift;
1735 if ( ref $cbset eq "ARRAY" and scalar( @$cbset ) == 4 ) {
1736 $self->{_CALLBACKS} = [grep { $_->[0] != $cbset->[0] } @{$self->{_CALLBACKS}}];
1737 }
1738 else {
1739 shift @{$self->{_CALLBACKS}};
1740 }
1741}
1742
1743# make libxml2 use the callbacks
1744sub init_callbacks {
1745 my $self = shift;
1746
1747 $_CUR_CB = undef;
1748 @_CB_STACK = ();
1749
1750 @_GLOBAL_CALLBACKS = @{ $self->{_CALLBACKS} };
1751
1752 if ( defined $XML::LibXML::match_cb and
1753 defined $XML::LibXML::open_cb and
1754 defined $XML::LibXML::read_cb and
1755 defined $XML::LibXML::close_cb ) {
1756 push @_GLOBAL_CALLBACKS, [$XML::LibXML::match_cb,
1757 $XML::LibXML::open_cb,
1758 $XML::LibXML::read_cb,
1759 $XML::LibXML::close_cb];
1760 }
1761
1762 $self->lib_init_callbacks();
1763}
1764
1765# reset libxml2's callbacks
1766sub cleanup_callbacks {
1767 my $self = shift;
1768
1769 $_CUR_CB = undef;
1770 @_GLOBAL_CALLBACKS = ();
1771 @_CB_STACK = ();
1772
1773 $self->lib_cleanup_callbacks();
1774}
1775
1776135µs35µs1;
1777
1778__END__
# spent 25µs within XML::LibXML::LIBXML_RUNTIME_VERSION which was called # once (25µs+0s) at line 122 of /usr/lib/perl5/XML/LibXML.pm
sub XML::LibXML::LIBXML_RUNTIME_VERSION; # xsub
# spent 10µs within XML::LibXML::LIBXML_VERSION which was called # once (10µs+0s) at line 123 of /usr/lib/perl5/XML/LibXML.pm
sub XML::LibXML::LIBXML_VERSION; # xsub
# spent 896µs within XML::LibXML::bootstrap which was called # once (896µs+0s) by DynaLoader::bootstrap at line 219 of /usr/lib/perl/5.10/DynaLoader.pm
sub XML::LibXML::bootstrap; # xsub