File | /usr/lib/perl5/XML/LibXML.pm |
Statements Executed | 124 |
Total Time | 0.0106318 seconds |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
2 | 1 | 2 | 896µs | 896µs | bootstrap(xsub) | XML::LibXML::
2 | 1 | 2 | 25µs | 25µs | LIBXML_RUNTIME_VERSION(xsub) | XML::LibXML::
2 | 1 | 2 | 10µs | 10µs | LIBXML_VERSION(xsub) | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN | XML::LibXML::Attr::
0 | 0 | 0 | 0s | 0s | setNamespace | XML::LibXML::Attr::
0 | 0 | 0 | 0s | 0s | BEGIN | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN | XML::LibXML::CDATASection::
0 | 0 | 0 | 0s | 0s | CLONE | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN | XML::LibXML::Comment::
0 | 0 | 0 | 0s | 0s | BEGIN | XML::LibXML::Document::
0 | 0 | 0 | 0s | 0s | actualEncoding | XML::LibXML::Document::
0 | 0 | 0 | 0s | 0s | insertPI | XML::LibXML::Document::
0 | 0 | 0 | 0s | 0s | insertProcessingInstruction | XML::LibXML::Document::
0 | 0 | 0 | 0s | 0s | process_xinclude | XML::LibXML::Document::
0 | 0 | 0 | 0s | 0s | serialize | XML::LibXML::Document::
0 | 0 | 0 | 0s | 0s | setDocumentElement | XML::LibXML::Document::
0 | 0 | 0 | 0s | 0s | toString | XML::LibXML::Document::
0 | 0 | 0 | 0s | 0s | BEGIN | XML::LibXML::DocumentFragment::
0 | 0 | 0 | 0s | 0s | toString | XML::LibXML::DocumentFragment::
0 | 0 | 0 | 0s | 0s | BEGIN | XML::LibXML::Dtd::
0 | 0 | 0 | 0s | 0s | BEGIN | XML::LibXML::Element::
0 | 0 | 0 | 0s | 0s | appendWellBalancedChunk | XML::LibXML::Element::
0 | 0 | 0 | 0s | 0s | getAttribute | XML::LibXML::Element::
0 | 0 | 0 | 0s | 0s | getAttributeNS | XML::LibXML::Element::
0 | 0 | 0 | 0s | 0s | getChildrenByLocalName | XML::LibXML::Element::
0 | 0 | 0 | 0s | 0s | getChildrenByTagName | XML::LibXML::Element::
0 | 0 | 0 | 0s | 0s | getChildrenByTagNameNS | XML::LibXML::Element::
0 | 0 | 0 | 0s | 0s | getElementsByLocalName | XML::LibXML::Element::
0 | 0 | 0 | 0s | 0s | getElementsByTagName | XML::LibXML::Element::
0 | 0 | 0 | 0s | 0s | getElementsByTagNameNS | XML::LibXML::Element::
0 | 0 | 0 | 0s | 0s | setAttribute | XML::LibXML::Element::
0 | 0 | 0 | 0s | 0s | setAttributeNS | XML::LibXML::Element::
0 | 0 | 0 | 0s | 0s | setNamespace | XML::LibXML::Element::
0 | 0 | 0 | 0s | 0s | BEGIN | XML::LibXML::InputCallback::
0 | 0 | 0 | 0s | 0s | _callback_close | XML::LibXML::InputCallback::
0 | 0 | 0 | 0s | 0s | _callback_match | XML::LibXML::InputCallback::
0 | 0 | 0 | 0s | 0s | _callback_open | XML::LibXML::InputCallback::
0 | 0 | 0 | 0s | 0s | _callback_read | XML::LibXML::InputCallback::
0 | 0 | 0 | 0s | 0s | cleanup_callbacks | XML::LibXML::InputCallback::
0 | 0 | 0 | 0s | 0s | init_callbacks | XML::LibXML::InputCallback::
0 | 0 | 0 | 0s | 0s | new | XML::LibXML::InputCallback::
0 | 0 | 0 | 0s | 0s | register_callbacks | XML::LibXML::InputCallback::
0 | 0 | 0 | 0s | 0s | unregister_callbacks | XML::LibXML::InputCallback::
0 | 0 | 0 | 0s | 0s | BEGIN | XML::LibXML::NamedNodeMap::
0 | 0 | 0 | 0s | 0s | getNamedItem | XML::LibXML::NamedNodeMap::
0 | 0 | 0 | 0s | 0s | getNamedItemNS | XML::LibXML::NamedNodeMap::
0 | 0 | 0 | 0s | 0s | item | XML::LibXML::NamedNodeMap::
0 | 0 | 0 | 0s | 0s | length | XML::LibXML::NamedNodeMap::
0 | 0 | 0 | 0s | 0s | new | XML::LibXML::NamedNodeMap::
0 | 0 | 0 | 0s | 0s | nodes | XML::LibXML::NamedNodeMap::
0 | 0 | 0 | 0s | 0s | removeNamedItem | XML::LibXML::NamedNodeMap::
0 | 0 | 0 | 0s | 0s | removeNamedItemNS | XML::LibXML::NamedNodeMap::
0 | 0 | 0 | 0s | 0s | setNamedItem | XML::LibXML::NamedNodeMap::
0 | 0 | 0 | 0s | 0s | setNamedItemNS | XML::LibXML::NamedNodeMap::
0 | 0 | 0 | 0s | 0s | getName | XML::LibXML::Namespace::
0 | 0 | 0 | 0s | 0s | getNamespaceURI | XML::LibXML::Namespace::
0 | 0 | 0 | 0s | 0s | getNamespaces | XML::LibXML::Namespace::
0 | 0 | 0 | 0s | 0s | getPrefix | XML::LibXML::Namespace::
0 | 0 | 0 | 0s | 0s | isEqualNode | XML::LibXML::Namespace::
0 | 0 | 0 | 0s | 0s | isSameNode | XML::LibXML::Namespace::
0 | 0 | 0 | 0s | 0s | name | XML::LibXML::Namespace::
0 | 0 | 0 | 0s | 0s | nodeName | XML::LibXML::Namespace::
0 | 0 | 0 | 0s | 0s | prefix | XML::LibXML::Namespace::
0 | 0 | 0 | 0s | 0s | attributes | XML::LibXML::Node::
0 | 0 | 0 | 0s | 0s | childNodes | XML::LibXML::Node::
0 | 0 | 0 | 0s | 0s | find | XML::LibXML::Node::
0 | 0 | 0 | 0s | 0s | findnodes | XML::LibXML::Node::
0 | 0 | 0 | 0s | 0s | findvalue | XML::LibXML::Node::
0 | 0 | 0 | 0s | 0s | getChildNodes | XML::LibXML::Node::
0 | 0 | 0 | 0s | 0s | isSupported | XML::LibXML::Node::
0 | 0 | 0 | 0s | 0s | setOwnerDocument | XML::LibXML::Node::
0 | 0 | 0 | 0s | 0s | toStringC14N | XML::LibXML::Node::
0 | 0 | 0 | 0s | 0s | toStringEC14N | XML::LibXML::Node::
0 | 0 | 0 | 0s | 0s | BEGIN | XML::LibXML::PI::
0 | 0 | 0 | 0s | 0s | setData | XML::LibXML::PI::
0 | 0 | 0 | 0s | 0s | new | XML::LibXML::RelaxNG::
0 | 0 | 0 | 0s | 0s | new | XML::LibXML::Schema::
0 | 0 | 0 | 0s | 0s | BEGIN | XML::LibXML::Text::
0 | 0 | 0 | 0s | 0s | attributes | XML::LibXML::Text::
0 | 0 | 0 | 0s | 0s | deleteDataString | XML::LibXML::Text::
0 | 0 | 0 | 0s | 0s | replaceDataRegEx | XML::LibXML::Text::
0 | 0 | 0 | 0s | 0s | replaceDataString | XML::LibXML::Text::
0 | 0 | 0 | 0s | 0s | BEGIN | XML::LibXML::_SAXParser::
0 | 0 | 0 | 0s | 0s | error | XML::LibXML::_SAXParser::
0 | 0 | 0 | 0s | 0s | fatal_error | XML::LibXML::_SAXParser::
0 | 0 | 0 | 0s | 0s | warning | XML::LibXML::_SAXParser::
0 | 0 | 0 | 0s | 0s | __read | XML::LibXML::
0 | 0 | 0 | 0s | 0s | __write | XML::LibXML::
0 | 0 | 0 | 0s | 0s | _auto_expand | XML::LibXML::
0 | 0 | 0 | 0s | 0s | _cleanup_callbacks | XML::LibXML::
0 | 0 | 0 | 0s | 0s | _html_options | XML::LibXML::
0 | 0 | 0 | 0s | 0s | _init_callbacks | XML::LibXML::
0 | 0 | 0 | 0s | 0s | _parser_options | XML::LibXML::
0 | 0 | 0 | 0s | 0s | base_uri | XML::LibXML::
0 | 0 | 0 | 0s | 0s | callbacks | XML::LibXML::
0 | 0 | 0 | 0s | 0s | clean_namespaces | XML::LibXML::
0 | 0 | 0 | 0s | 0s | close_callback | XML::LibXML::
0 | 0 | 0 | 0s | 0s | complete_attributes | XML::LibXML::
0 | 0 | 0 | 0s | 0s | createDocument | XML::LibXML::
0 | 0 | 0 | 0s | 0s | expand_entities | XML::LibXML::
0 | 0 | 0 | 0s | 0s | expand_xinclude | XML::LibXML::
0 | 0 | 0 | 0s | 0s | finish_push | XML::LibXML::
0 | 0 | 0 | 0s | 0s | gdome_dom | XML::LibXML::
0 | 0 | 0 | 0s | 0s | init_push | XML::LibXML::
0 | 0 | 0 | 0s | 0s | input_callbacks | XML::LibXML::
0 | 0 | 0 | 0s | 0s | keep_blanks | XML::LibXML::
0 | 0 | 0 | 0s | 0s | line_numbers | XML::LibXML::
0 | 0 | 0 | 0s | 0s | load_ext_dtd | XML::LibXML::
0 | 0 | 0 | 0s | 0s | match_callback | XML::LibXML::
0 | 0 | 0 | 0s | 0s | new | XML::LibXML::
0 | 0 | 0 | 0s | 0s | no_network | XML::LibXML::
0 | 0 | 0 | 0s | 0s | open_callback | XML::LibXML::
0 | 0 | 0 | 0s | 0s | parse_balanced_chunk | XML::LibXML::
0 | 0 | 0 | 0s | 0s | parse_chunk | XML::LibXML::
0 | 0 | 0 | 0s | 0s | parse_fh | XML::LibXML::
0 | 0 | 0 | 0s | 0s | parse_file | XML::LibXML::
0 | 0 | 0 | 0s | 0s | parse_html_fh | XML::LibXML::
0 | 0 | 0 | 0s | 0s | parse_html_file | XML::LibXML::
0 | 0 | 0 | 0s | 0s | parse_html_string | XML::LibXML::
0 | 0 | 0 | 0s | 0s | parse_string | XML::LibXML::
0 | 0 | 0 | 0s | 0s | parse_xml_chunk | XML::LibXML::
0 | 0 | 0 | 0s | 0s | pedantic_parser | XML::LibXML::
0 | 0 | 0 | 0s | 0s | processXIncludes | XML::LibXML::
0 | 0 | 0 | 0s | 0s | process_xincludes | XML::LibXML::
0 | 0 | 0 | 0s | 0s | push | XML::LibXML::
0 | 0 | 0 | 0s | 0s | read_callback | XML::LibXML::
0 | 0 | 0 | 0s | 0s | recover | XML::LibXML::
0 | 0 | 0 | 0s | 0s | recover_silently | XML::LibXML::
0 | 0 | 0 | 0s | 0s | set_handler | XML::LibXML::
0 | 0 | 0 | 0s | 0s | validation | XML::LibXML::
Line | Stmts. | Exclusive Time | Avg. | Code |
---|---|---|---|---|
1 | # $Id: LibXML.pm 709 2008-01-29 21:01:32Z pajas $ | |||
2 | ||||
3 | package XML::LibXML; | |||
4 | ||||
5 | 3 | 39µs | 13µs | use strict; # spent 7µs making 1 call to strict::import |
6 | 1 | 11µs | 11µs | use 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 | |||
9 | 2 | 19µs | 9µs | ); |
10 | 3 | 28µs | 9µs | use Carp; # spent 58µs making 1 call to Exporter::import |
11 | ||||
12 | 3 | 137µs | 46µs | use XML::LibXML::Common qw(:encoding :libxml); # spent 360µs making 1 call to Exporter::import |
13 | ||||
14 | 3 | 28µs | 9µs | use constant XML_XMLNS_NS => 'http://www.w3.org/2000/xmlns/'; # spent 48µs making 1 call to constant::import |
15 | 3 | 23µs | 8µs | use constant XML_XML_NS => 'http://www.w3.org/XML/1998/namespace'; # spent 45µs making 1 call to constant::import |
16 | ||||
17 | 3 | 140µs | 47µs | use XML::LibXML::NodeList; # spent 4µs making 1 call to import |
18 | 3 | 126µs | 42µs | use XML::LibXML::XPathContext; # spent 4µs making 1 call to import |
19 | 3 | 255µs | 85µs | use IO::Handle; # for FH reads called as methods # spent 28µs making 1 call to Exporter::import |
20 | ||||
21 | BEGIN { | |||
22 | ||||
23 | 1 | 900ns | 900ns | $VERSION = "1.66"; # VERSION TEMPLATE: DO NOT CHANGE |
24 | 1 | 600ns | 600ns | require Exporter; |
25 | 1 | 7µs | 7µs | require DynaLoader; |
26 | 1 | 12µs | 12µs | @ISA = qw(DynaLoader Exporter); |
27 | ||||
28 | #-------------------------------------------------------------------------# | |||
29 | # export information # | |||
30 | #-------------------------------------------------------------------------# | |||
31 | 1 | 13µs | 13µs | %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 | 1 | 11µs | 11µs | @{$EXPORT_TAGS{all}}, |
92 | ); | |||
93 | ||||
94 | @EXPORT = ( | |||
95 | 1 | 24µs | 24µs | @{$EXPORT_TAGS{all}}, |
96 | ); | |||
97 | ||||
98 | #-------------------------------------------------------------------------# | |||
99 | # initialization of the global variables # | |||
100 | #-------------------------------------------------------------------------# | |||
101 | 1 | 400ns | 400ns | $skipDTD = 0; |
102 | 1 | 300ns | 300ns | $skipXMLDeclaration = 0; |
103 | 1 | 300ns | 300ns | $setTagCompression = 0; |
104 | ||||
105 | 1 | 300ns | 300ns | $MatchCB = undef; |
106 | 1 | 300ns | 300ns | $ReadCB = undef; |
107 | 1 | 200ns | 200ns | $OpenCB = undef; |
108 | 1 | 200ns | 200ns | $CloseCB = undef; |
109 | ||||
110 | #-------------------------------------------------------------------------# | |||
111 | # bootstrapping # | |||
112 | #-------------------------------------------------------------------------# | |||
113 | 1 | 14µs | 14µs | bootstrap XML::LibXML $VERSION; # spent 1.26ms making 1 call to DynaLoader::bootstrap |
114 | 1 | 9µs | 9µs | undef &AUTOLOAD; |
115 | ||||
116 | 1 | 4.69ms | 4.69ms | } # BEGIN |
117 | ||||
118 | #-------------------------------------------------------------------------# | |||
119 | # test exact version (up to patch-level) # | |||
120 | #-------------------------------------------------------------------------# | |||
121 | { | |||
122 | 2 | 30µs | 15µs | my ($runtime_version) = LIBXML_RUNTIME_VERSION() =~ /^(\d+)/; # spent 25µs making 1 call to XML::LibXML::LIBXML_RUNTIME_VERSION |
123 | 1 | 13µs | 13µs | 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 | #-------------------------------------------------------------------------# | |||
132 | sub 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 | |||
160 | sub CLONE { XML::LibXML::_CLONE( $_[0] ) } | |||
161 | ||||
162 | #-------------------------------------------------------------------------# | |||
163 | # DOM Level 2 document constructor # | |||
164 | #-------------------------------------------------------------------------# | |||
165 | ||||
166 | sub 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 | ||||
186 | sub 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 | ||||
196 | sub 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 | ||||
211 | sub 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 | ||||
226 | sub 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 | ||||
241 | sub 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 | ||||
256 | sub 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 | #-------------------------------------------------------------------------# | |||
281 | sub validation { | |||
282 | my $self = shift; | |||
283 | $self->{XML_LIBXML_VALIDATION} = shift if scalar @_; | |||
284 | return $self->{XML_LIBXML_VALIDATION}; | |||
285 | } | |||
286 | ||||
287 | sub recover { | |||
288 | my $self = shift; | |||
289 | $self->{XML_LIBXML_RECOVER} = shift if scalar @_; | |||
290 | return $self->{XML_LIBXML_RECOVER}; | |||
291 | } | |||
292 | ||||
293 | sub 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 | ||||
300 | sub expand_entities { | |||
301 | my $self = shift; | |||
302 | $self->{XML_LIBXML_EXPAND_ENTITIES} = shift if scalar @_; | |||
303 | return $self->{XML_LIBXML_EXPAND_ENTITIES}; | |||
304 | } | |||
305 | ||||
306 | sub keep_blanks { | |||
307 | my $self = shift; | |||
308 | $self->{XML_LIBXML_KEEP_BLANKS} = shift if scalar @_; | |||
309 | return $self->{XML_LIBXML_KEEP_BLANKS}; | |||
310 | } | |||
311 | ||||
312 | sub pedantic_parser { | |||
313 | my $self = shift; | |||
314 | $self->{XML_LIBXML_PEDANTIC} = shift if scalar @_; | |||
315 | return $self->{XML_LIBXML_PEDANTIC}; | |||
316 | } | |||
317 | ||||
318 | sub line_numbers { | |||
319 | my $self = shift; | |||
320 | $self->{XML_LIBXML_LINENUMBERS} = shift if scalar @_; | |||
321 | return $self->{XML_LIBXML_LINENUMBERS}; | |||
322 | } | |||
323 | ||||
324 | sub no_network { | |||
325 | my $self = shift; | |||
326 | $self->{XML_LIBXML_NONET} = shift if scalar @_; | |||
327 | return $self->{XML_LIBXML_NONET}; | |||
328 | } | |||
329 | ||||
330 | sub 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 | ||||
336 | sub complete_attributes { | |||
337 | my $self = shift; | |||
338 | $self->{XML_LIBXML_COMPLETE_ATTR} = shift if scalar @_; | |||
339 | return $self->{XML_LIBXML_COMPLETE_ATTR}; | |||
340 | } | |||
341 | ||||
342 | sub expand_xinclude { | |||
343 | my $self = shift; | |||
344 | $self->{XML_LIBXML_EXPAND_XINCLUDE} = shift if scalar @_; | |||
345 | return $self->{XML_LIBXML_EXPAND_XINCLUDE}; | |||
346 | } | |||
347 | ||||
348 | sub base_uri { | |||
349 | my $self = shift; | |||
350 | $self->{XML_LIBXML_BASE_URI} = shift if scalar @_; | |||
351 | return $self->{XML_LIBXML_BASE_URI}; | |||
352 | } | |||
353 | ||||
354 | sub gdome_dom { | |||
355 | my $self = shift; | |||
356 | $self->{XML_LIBXML_GDOME} = shift if scalar @_; | |||
357 | return $self->{XML_LIBXML_GDOME}; | |||
358 | } | |||
359 | ||||
360 | sub 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 | #-------------------------------------------------------------------------# | |||
369 | sub 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 | #-------------------------------------------------------------------------# | |||
388 | sub _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 | ||||
408 | sub _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 | ||||
429 | sub _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 | ||||
436 | sub __read { | |||
437 | read($_[0], $_[1], $_[2]); | |||
438 | } | |||
439 | ||||
440 | sub __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 | |||
453 | sub _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 | #-------------------------------------------------------------------------# | |||
482 | sub 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 | ||||
528 | sub 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 | ||||
566 | sub 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 | ||||
603 | sub 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 | ||||
648 | sub 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 | |||
665 | sub 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 | |||
690 | sub 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 | ||||
714 | sub _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 | ||||
728 | sub 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 | ||||
758 | sub 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 | ||||
782 | sub 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 | #-------------------------------------------------------------------------# | |||
808 | sub 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 | ||||
823 | sub 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! | |||
847 | sub 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 | ||||
866 | sub 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 | ||||
891 | 1 | 100ns | 100ns | 1; |
892 | ||||
893 | #-------------------------------------------------------------------------# | |||
894 | # XML::LibXML::Node Interface # | |||
895 | #-------------------------------------------------------------------------# | |||
896 | package XML::LibXML::Node; | |||
897 | ||||
898 | sub isSupported { | |||
899 | my $self = shift; | |||
900 | my $feature = shift; | |||
901 | return $self->can($feature) ? 1 : 0; | |||
902 | } | |||
903 | ||||
904 | sub getChildNodes { my $self = shift; return $self->childNodes(); } | |||
905 | ||||
906 | sub childNodes { | |||
907 | my $self = shift; | |||
908 | my @children = $self->_childNodes(); | |||
909 | return wantarray ? @children : XML::LibXML::NodeList->new_from_ref(\@children , 1); | |||
910 | } | |||
911 | ||||
912 | sub attributes { | |||
913 | my $self = shift; | |||
914 | my @attr = $self->_attributes(); | |||
915 | return wantarray ? @attr : XML::LibXML::NamedNodeMap->new( @attr ); | |||
916 | } | |||
917 | ||||
918 | ||||
919 | sub 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 | ||||
930 | sub 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 | ||||
942 | sub 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 | ||||
951 | sub setOwnerDocument { | |||
952 | my ( $self, $doc ) = @_; | |||
953 | $doc->adoptNode( $self ); | |||
954 | } | |||
955 | ||||
956 | sub 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 | } | |||
963 | sub 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 | ||||
974 | 1 | 3µs | 3µs | *serialize_c14n = \&toStringC14N; |
975 | 1 | 900ns | 900ns | *serialize_exc_c14n = \&toStringEC14N; |
976 | ||||
977 | 1 | 100ns | 100ns | 1; |
978 | ||||
979 | #-------------------------------------------------------------------------# | |||
980 | # XML::LibXML::Document Interface # | |||
981 | #-------------------------------------------------------------------------# | |||
982 | package XML::LibXML::Document; | |||
983 | ||||
984 | 3 | 543µs | 181µs | use vars qw(@ISA); # spent 37µs making 1 call to vars::import |
985 | 1 | 10µs | 10µs | @ISA = ('XML::LibXML::Node'); |
986 | ||||
987 | sub actualEncoding { | |||
988 | my $doc = shift; | |||
989 | my $enc = $doc->encoding; | |||
990 | return (defined $enc and length $enc) ? $enc : 'UTF-8'; | |||
991 | } | |||
992 | ||||
993 | sub 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 | ||||
1005 | sub 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 | ||||
1027 | sub serialize { | |||
1028 | my $self = shift; | |||
1029 | return $self->toString( @_ ); | |||
1030 | } | |||
1031 | ||||
1032 | #-------------------------------------------------------------------------# | |||
1033 | # bad style xinclude processing # | |||
1034 | #-------------------------------------------------------------------------# | |||
1035 | sub process_xinclude { | |||
1036 | my $self = shift; | |||
1037 | my $opts = shift; | |||
1038 | XML::LibXML->new->processXIncludes( $self, $opts ); | |||
1039 | } | |||
1040 | ||||
1041 | sub 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 | ||||
1060 | sub insertPI { | |||
1061 | my $self = shift; | |||
1062 | $self->insertProcessingInstruction( @_ ); | |||
1063 | } | |||
1064 | ||||
1065 | #-------------------------------------------------------------------------# | |||
1066 | # DOM L3 Document functions. | |||
1067 | # added after robins implicit feature requst | |||
1068 | #-------------------------------------------------------------------------# | |||
1069 | 1 | 1µs | 1µs | *getElementsByTagName = \&XML::LibXML::Element::getElementsByTagName; |
1070 | 1 | 800ns | 800ns | *getElementsByTagNameNS = \&XML::LibXML::Element::getElementsByTagNameNS; |
1071 | 1 | 800ns | 800ns | *getElementsByLocalName = \&XML::LibXML::Element::getElementsByLocalName; |
1072 | ||||
1073 | 1 | 100ns | 100ns | 1; |
1074 | ||||
1075 | #-------------------------------------------------------------------------# | |||
1076 | # XML::LibXML::DocumentFragment Interface # | |||
1077 | #-------------------------------------------------------------------------# | |||
1078 | package XML::LibXML::DocumentFragment; | |||
1079 | ||||
1080 | 3 | 119µs | 40µs | use vars qw(@ISA); # spent 22µs making 1 call to vars::import |
1081 | 1 | 19µs | 19µs | @ISA = ('XML::LibXML::Node'); |
1082 | ||||
1083 | sub 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 | ||||
1094 | 1 | 1µs | 1µs | *serialize = \&toString; |
1095 | ||||
1096 | 1 | 200ns | 200ns | 1; |
1097 | ||||
1098 | #-------------------------------------------------------------------------# | |||
1099 | # XML::LibXML::Element Interface # | |||
1100 | #-------------------------------------------------------------------------# | |||
1101 | package XML::LibXML::Element; | |||
1102 | ||||
1103 | 3 | 41µs | 14µs | use vars qw(@ISA); # spent 28µs making 1 call to vars::import |
1104 | 1 | 5µs | 5µs | @ISA = ('XML::LibXML::Node'); |
1105 | 3 | 32µs | 10µs | use XML::LibXML qw(:ns :libxml); # spent 326µs making 1 call to Exporter::import |
1106 | 3 | 1.27ms | 423µs | use Carp; # spent 56µs making 1 call to Exporter::import |
1107 | ||||
1108 | sub 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 | ||||
1120 | sub 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 | ||||
1133 | sub 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 | ||||
1166 | sub 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 | ||||
1178 | sub 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 | ||||
1202 | sub 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 | ||||
1209 | sub 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 | ||||
1227 | sub 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 | ||||
1239 | sub 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 | ||||
1251 | sub 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 | ||||
1264 | sub 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 | ||||
1270 | sub 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 | ||||
1279 | 1 | 200ns | 200ns | 1; |
1280 | ||||
1281 | #-------------------------------------------------------------------------# | |||
1282 | # XML::LibXML::Text Interface # | |||
1283 | #-------------------------------------------------------------------------# | |||
1284 | package XML::LibXML::Text; | |||
1285 | ||||
1286 | 3 | 376µs | 125µs | use vars qw(@ISA); # spent 27µs making 1 call to vars::import |
1287 | 1 | 7µs | 7µs | @ISA = ('XML::LibXML::Node'); |
1288 | ||||
1289 | sub attributes { return undef; } | |||
1290 | ||||
1291 | sub 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 | ||||
1306 | sub 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 | ||||
1321 | sub 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 | ||||
1335 | 1 | 100ns | 100ns | 1; |
1336 | ||||
1337 | package XML::LibXML::Comment; | |||
1338 | ||||
1339 | 3 | 46µs | 15µs | use vars qw(@ISA); # spent 27µs making 1 call to vars::import |
1340 | 1 | 5µs | 5µs | @ISA = ('XML::LibXML::Text'); |
1341 | ||||
1342 | 1 | 200ns | 200ns | 1; |
1343 | ||||
1344 | package XML::LibXML::CDATASection; | |||
1345 | ||||
1346 | 3 | 42µs | 14µs | use vars qw(@ISA); # spent 19µs making 1 call to vars::import |
1347 | 1 | 4µs | 4µs | @ISA = ('XML::LibXML::Text'); |
1348 | ||||
1349 | 1 | 200ns | 200ns | 1; |
1350 | ||||
1351 | #-------------------------------------------------------------------------# | |||
1352 | # XML::LibXML::Attribute Interface # | |||
1353 | #-------------------------------------------------------------------------# | |||
1354 | package XML::LibXML::Attr; | |||
1355 | 3 | 110µs | 37µs | use vars qw( @ISA ) ; # spent 22µs making 1 call to vars::import |
1356 | 1 | 8µs | 8µs | @ISA = ('XML::LibXML::Node') ; |
1357 | ||||
1358 | sub 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 | ||||
1369 | 1 | 200ns | 200ns | 1; |
1370 | ||||
1371 | #-------------------------------------------------------------------------# | |||
1372 | # XML::LibXML::Dtd Interface # | |||
1373 | #-------------------------------------------------------------------------# | |||
1374 | # this is still under construction | |||
1375 | # | |||
1376 | package XML::LibXML::Dtd; | |||
1377 | 3 | 46µs | 15µs | use vars qw( @ISA ); # spent 32µs making 1 call to vars::import |
1378 | 1 | 4µs | 4µs | @ISA = ('XML::LibXML::Node'); |
1379 | ||||
1380 | 1 | 200ns | 200ns | 1; |
1381 | ||||
1382 | #-------------------------------------------------------------------------# | |||
1383 | # XML::LibXML::PI Interface # | |||
1384 | #-------------------------------------------------------------------------# | |||
1385 | package XML::LibXML::PI; | |||
1386 | 3 | 426µs | 142µs | use vars qw( @ISA ); # spent 26µs making 1 call to vars::import |
1387 | 1 | 3µs | 3µs | @ISA = ('XML::LibXML::Node'); |
1388 | ||||
1389 | sub 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 | ||||
1405 | 1 | 200ns | 200ns | 1; |
1406 | ||||
1407 | #-------------------------------------------------------------------------# | |||
1408 | # XML::LibXML::Namespace Interface # | |||
1409 | #-------------------------------------------------------------------------# | |||
1410 | package XML::LibXML::Namespace; | |||
1411 | ||||
1412 | # this is infact not a node! | |||
1413 | sub prefix { return "xmlns"; } | |||
1414 | sub getPrefix { return "xmlns"; } | |||
1415 | sub getNamespaceURI { return "http://www.w3.org/2000/xmlns/" }; | |||
1416 | ||||
1417 | sub getNamespaces { return (); } | |||
1418 | ||||
1419 | sub nodeName { | |||
1420 | my $self = shift; | |||
1421 | my $nsP = $self->localname; | |||
1422 | return ( defined($nsP) && length($nsP) ) ? "xmlns:$nsP" : "xmlns"; | |||
1423 | } | |||
1424 | sub name { goto &nodeName } | |||
1425 | sub getName { goto &nodeName } | |||
1426 | ||||
1427 | sub isEqualNode { | |||
1428 | my ( $self, $ref ) = @_; | |||
1429 | if ( ref($ref) eq "XML::LibXML::Namespace" ) { | |||
1430 | return $self->_isEqual($ref); | |||
1431 | } | |||
1432 | return 0; | |||
1433 | } | |||
1434 | ||||
1435 | sub isSameNode { | |||
1436 | my ( $self, $ref ) = @_; | |||
1437 | if ( $$self == $$ref ){ | |||
1438 | return 1; | |||
1439 | } | |||
1440 | return 0; | |||
1441 | } | |||
1442 | ||||
1443 | 1 | 200ns | 200ns | 1; |
1444 | ||||
1445 | #-------------------------------------------------------------------------# | |||
1446 | # XML::LibXML::NamedNodeMap Interface # | |||
1447 | #-------------------------------------------------------------------------# | |||
1448 | package XML::LibXML::NamedNodeMap; | |||
1449 | ||||
1450 | 3 | 686µs | 229µs | use XML::LibXML::Common qw(:libxml); # spent 249µs making 1 call to Exporter::import |
1451 | ||||
1452 | sub new { | |||
1453 | my $class = shift; | |||
1454 | my $self = bless { Nodes => [@_] }, $class; | |||
1455 | $self->{NodeMap} = { map { $_->nodeName => $_ } @_ }; | |||
1456 | return $self; | |||
1457 | } | |||
1458 | ||||
1459 | sub length { return scalar( @{$_[0]->{Nodes}} ); } | |||
1460 | sub nodes { return $_[0]->{Nodes}; } | |||
1461 | sub item { $_[0]->{Nodes}->[$_[1]]; } | |||
1462 | ||||
1463 | sub getNamedItem { | |||
1464 | my $self = shift; | |||
1465 | my $name = shift; | |||
1466 | ||||
1467 | return $self->{NodeMap}->{$name}; | |||
1468 | } | |||
1469 | ||||
1470 | sub 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 | ||||
1503 | sub 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 | ||||
1520 | sub getNamedItemNS { | |||
1521 | my $self = shift; | |||
1522 | my $nsURI = shift; | |||
1523 | my $name = shift; | |||
1524 | return undef; | |||
1525 | } | |||
1526 | ||||
1527 | sub setNamedItemNS { | |||
1528 | my $self = shift; | |||
1529 | my $nsURI = shift; | |||
1530 | my $node = shift; | |||
1531 | return undef; | |||
1532 | } | |||
1533 | ||||
1534 | sub removeNamedItemNS { | |||
1535 | my $self = shift; | |||
1536 | my $nsURI = shift; | |||
1537 | my $name = shift; | |||
1538 | return undef; | |||
1539 | } | |||
1540 | ||||
1541 | 1 | 100ns | 100ns | 1; |
1542 | ||||
1543 | package XML::LibXML::_SAXParser; | |||
1544 | ||||
1545 | # this is pseudo class!!! and it will be removed as soon all functions | |||
1546 | # moved to XS level | |||
1547 | ||||
1548 | 3 | 410µs | 137µs | use 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 | |||
1551 | sub 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 | ||||
1559 | sub 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 | ||||
1568 | sub 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 | ||||
1576 | 1 | 200ns | 200ns | 1; |
1577 | ||||
1578 | package XML::LibXML::RelaxNG; | |||
1579 | ||||
1580 | sub 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 | ||||
1598 | 1 | 100ns | 100ns | 1; |
1599 | ||||
1600 | package XML::LibXML::Schema; | |||
1601 | ||||
1602 | sub 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 | ||||
1617 | 1 | 200ns | 200ns | 1; |
1618 | ||||
1619 | #-------------------------------------------------------------------------# | |||
1620 | # XML::LibXML::InputCallback Interface # | |||
1621 | #-------------------------------------------------------------------------# | |||
1622 | package XML::LibXML::InputCallback; | |||
1623 | ||||
1624 | 3 | 739µs | 246µs | use vars qw($_CUR_CB @_GLOBAL_CALLBACKS @_CB_STACK); # spent 54µs making 1 call to vars::import |
1625 | ||||
1626 | 1 | 400ns | 400ns | $_CUR_CB = undef; |
1627 | ||||
1628 | 1 | 400ns | 400ns | @_GLOBAL_CALLBACKS = (); |
1629 | 1 | 300ns | 300ns | @_CB_STACK = (); |
1630 | ||||
1631 | #-------------------------------------------------------------------------# | |||
1632 | # global callbacks # | |||
1633 | #-------------------------------------------------------------------------# | |||
1634 | sub _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 | ||||
1661 | sub _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 | ||||
1683 | sub _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 | ||||
1696 | sub _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 | ||||
1713 | sub 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] ); | |||
1720 | sub 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 | |||
1732 | sub 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 | |||
1744 | sub 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 | |||
1766 | sub 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 | ||||
1776 | 1 | 35µs | 35µs | 1; |
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 | ||||
# 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 | ||||
# 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 |