Filename | /usr/local/lib/perl5/site_perl/mach/5.32/XML/LibXML.pm |
Statements | Executed 0 statements in 0s |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 75µs | 75µs | END (xsub) | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@1837 | XML::LibXML::Attr::
0 | 0 | 0 | 0s | 0s | setNamespace | XML::LibXML::Attr::
0 | 0 | 0 | 0s | 0s | BEGIN@13 | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@14 | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@16 | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@162 | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@163 | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@164 | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@165 | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@166 | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@167 | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@168 | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@169 | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@170 | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@171 | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@172 | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@173 | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@174 | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@175 | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@176 | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@177 | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@178 | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@179 | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@180 | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@181 | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@21 | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@23 | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@237 | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@24 | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@26 | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@27 | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@28 | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@29 | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@31 | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@35 | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@38 | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@1828 | XML::LibXML::CDATASection::
0 | 0 | 0 | 0s | 0s | CLONE | XML::LibXML::
0 | 0 | 0 | 0s | 0s | CLONE_SKIP | XML::LibXML::
0 | 0 | 0 | 0s | 0s | CORE:match (opcode) | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@1821 | XML::LibXML::Comment::
0 | 0 | 0 | 0s | 0s | BEGIN@1418 | 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@1514 | XML::LibXML::DocumentFragment::
0 | 0 | 0 | 0s | 0s | toString | XML::LibXML::DocumentFragment::
0 | 0 | 0 | 0s | 0s | BEGIN@1859 | XML::LibXML::Dtd::
0 | 0 | 0 | 0s | 0s | BEGIN@1537 | XML::LibXML::Element::
0 | 0 | 0 | 0s | 0s | BEGIN@1539 | XML::LibXML::Element::
0 | 0 | 0 | 0s | 0s | BEGIN@1540 | XML::LibXML::Element::
0 | 0 | 0 | 0s | 0s | BEGIN@1541 | XML::LibXML::Element::
0 | 0 | 0 | 0s | 0s | BEGIN@1543 | XML::LibXML::Element::
0 | 0 | 0 | 0s | 0s | BEGIN@1546 | XML::LibXML::Element::
0 | 0 | 0 | 0s | 0s | DESTROY | XML::LibXML::Element::
0 | 0 | 0 | 0s | 0s | __ANON__ (xsub) | XML::LibXML::Element::
0 | 0 | 0 | 0s | 0s | __destroy_tiecache | XML::LibXML::Element::
0 | 0 | 0 | 0s | 0s | _isNotSameNodeLax | XML::LibXML::Element::
0 | 0 | 0 | 0s | 0s | _isSameNodeLax | 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 | getAttributeHash | 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@2182 | XML::LibXML::InputCallback::
0 | 0 | 0 | 0s | 0s | BEGIN@2184 | XML::LibXML::InputCallback::
0 | 0 | 0 | 0s | 0s | CLONE_SKIP | 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 | LIBXML_RUNTIME_VERSION (xsub) | XML::LibXML::
0 | 0 | 0 | 0s | 0s | LIBXML_VERSION (xsub) | XML::LibXML::
0 | 0 | 0 | 0s | 0s | BEGIN@1936 | XML::LibXML::NamedNodeMap::
0 | 0 | 0 | 0s | 0s | CLONE_SKIP | 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 | CLONE_SKIP | XML::LibXML::Namespace::
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 | BEGIN@1272 | XML::LibXML::Node::
0 | 0 | 0 | 0s | 0s | BEGIN@1275 | XML::LibXML::Node::
0 | 0 | 0 | 0s | 0s | CLONE_SKIP | XML::LibXML::Node::
0 | 0 | 0 | 0s | 0s | __ANON__[:1275] | XML::LibXML::Node::
0 | 0 | 0 | 0s | 0s | __ANON__[:1276] | XML::LibXML::Node::
0 | 0 | 0 | 0s | 0s | __ANON__[:1277] | XML::LibXML::Node::
0 | 0 | 0 | 0s | 0s | attributes | XML::LibXML::Node::
0 | 0 | 0 | 0s | 0s | childNodes | XML::LibXML::Node::
0 | 0 | 0 | 0s | 0s | exists | XML::LibXML::Node::
0 | 0 | 0 | 0s | 0s | find | XML::LibXML::Node::
0 | 0 | 0 | 0s | 0s | findbool | 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 | nonBlankChildNodes | 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 | toStringC14N_v1_1 | XML::LibXML::Node::
0 | 0 | 0 | 0s | 0s | toStringEC14N | XML::LibXML::Node::
0 | 0 | 0 | 0s | 0s | BEGIN@1870 | XML::LibXML::PI::
0 | 0 | 0 | 0s | 0s | setData | XML::LibXML::PI::
0 | 0 | 0 | 0s | 0s | CLONE_SKIP | XML::LibXML::Pattern::
0 | 0 | 0 | 0s | 0s | new | XML::LibXML::Pattern::
0 | 0 | 0 | 0s | 0s | CLONE_SKIP | XML::LibXML::RegExp::
0 | 0 | 0 | 0s | 0s | new | XML::LibXML::RegExp::
0 | 0 | 0 | 0s | 0s | CLONE_SKIP | XML::LibXML::RelaxNG::
0 | 0 | 0 | 0s | 0s | new | XML::LibXML::RelaxNG::
0 | 0 | 0 | 0s | 0s | CLONE_SKIP | XML::LibXML::Schema::
0 | 0 | 0 | 0s | 0s | new | XML::LibXML::Schema::
0 | 0 | 0 | 0s | 0s | BEGIN@1776 | 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 | VERSION | XML::LibXML::
0 | 0 | 0 | 0s | 0s | CLONE_SKIP | XML::LibXML::XPathExpression::
0 | 0 | 0 | 0s | 0s | BEGIN@2038 | XML::LibXML::_SAXParser::
0 | 0 | 0 | 0s | 0s | CLONE_SKIP | XML::LibXML::_SAXParser::
0 | 0 | 0 | 0s | 0s | __ANON__ (xsub) | 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 | __ANON__ (xsub) | XML::LibXML::
0 | 0 | 0 | 0s | 0s | __parser_option | XML::LibXML::
0 | 0 | 0 | 0s | 0s | __proxy_registry | XML::LibXML::
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 | _clone | 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 | externalEntityLoader | 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 | get_option | XML::LibXML::
0 | 0 | 0 | 0s | 0s | import | 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 | load_html | XML::LibXML::
0 | 0 | 0 | 0s | 0s | load_xml | 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 | option_exists | 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 | set_option | XML::LibXML::
0 | 0 | 0 | 0s | 0s | set_options | XML::LibXML::
0 | 0 | 0 | 0s | 0s | threads_shared_enabled | XML::LibXML::
0 | 0 | 0 | 0s | 0s | validation | XML::LibXML::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | # $Id$ | ||||
2 | # | ||||
3 | # | ||||
4 | # This is free software, you may use it and distribute it under the same terms as | ||||
5 | # Perl itself. | ||||
6 | # | ||||
7 | # Copyright 2001-2003 AxKit.com Ltd., 2002-2006 Christian Glahn, 2006-2009 Petr Pajas | ||||
8 | # | ||||
9 | # | ||||
10 | |||||
11 | package XML::LibXML; | ||||
12 | |||||
13 | use strict; | ||||
14 | use warnings; | ||||
15 | |||||
16 | use vars qw($VERSION $ABI_VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS | ||||
17 | $skipDTD $skipXMLDeclaration $setTagCompression | ||||
18 | $MatchCB $ReadCB $OpenCB $CloseCB %PARSER_FLAGS | ||||
19 | $XML_LIBXML_PARSE_DEFAULTS | ||||
20 | ); | ||||
21 | use Carp; | ||||
22 | |||||
23 | use constant XML_XMLNS_NS => 'http://www.w3.org/2000/xmlns/'; | ||||
24 | use constant XML_XML_NS => 'http://www.w3.org/XML/1998/namespace'; | ||||
25 | |||||
26 | use XML::LibXML::Error; | ||||
27 | use XML::LibXML::NodeList; | ||||
28 | use XML::LibXML::XPathContext; | ||||
29 | use IO::Handle; # for FH reads called as methods | ||||
30 | |||||
31 | BEGIN { | ||||
32 | $VERSION = "2.0207"; # VERSION TEMPLATE: DO NOT CHANGE | ||||
33 | $ABI_VERSION = 2; | ||||
34 | require Exporter; | ||||
35 | use XSLoader (); | ||||
36 | @ISA = qw(Exporter); | ||||
37 | |||||
38 | use vars qw($__PROXY_NODE_REGISTRY $__threads_shared $__PROXY_NODE_REGISTRY_MUTEX $__loaded); | ||||
39 | |||||
40 | sub VERSION { | ||||
41 | my $class = shift; | ||||
42 | my ($caller) = caller; | ||||
43 | my $req_abi = $ABI_VERSION; | ||||
44 | if (UNIVERSAL::can($caller,'REQUIRE_XML_LIBXML_ABI_VERSION')) { | ||||
45 | $req_abi = $caller->REQUIRE_XML_LIBXML_ABI_VERSION(); | ||||
46 | } elsif ($caller eq 'XML::LibXSLT') { | ||||
47 | # XML::LibXSLT without REQUIRE_XML_LIBXML_ABI_VERSION is an old and incompatible version | ||||
48 | $req_abi = 1; | ||||
49 | } | ||||
50 | unless ($req_abi == $ABI_VERSION) { | ||||
51 | my $ver = @_ ? ' '.$_[0] : ''; | ||||
52 | die ("This version of $caller requires XML::LibXML$ver (ABI $req_abi), which is incompatible with currently installed XML::LibXML $VERSION (ABI $ABI_VERSION). Please upgrade $caller, XML::LibXML, or both!"); | ||||
53 | } | ||||
54 | return $class->UNIVERSAL::VERSION(@_) | ||||
55 | } | ||||
56 | |||||
57 | #-------------------------------------------------------------------------# | ||||
58 | # export information # | ||||
59 | #-------------------------------------------------------------------------# | ||||
60 | %EXPORT_TAGS = ( | ||||
61 | all => [qw( | ||||
62 | XML_ELEMENT_NODE | ||||
63 | XML_ATTRIBUTE_NODE | ||||
64 | XML_TEXT_NODE | ||||
65 | XML_CDATA_SECTION_NODE | ||||
66 | XML_ENTITY_REF_NODE | ||||
67 | XML_ENTITY_NODE | ||||
68 | XML_PI_NODE | ||||
69 | XML_COMMENT_NODE | ||||
70 | XML_DOCUMENT_NODE | ||||
71 | XML_DOCUMENT_TYPE_NODE | ||||
72 | XML_DOCUMENT_FRAG_NODE | ||||
73 | XML_NOTATION_NODE | ||||
74 | XML_HTML_DOCUMENT_NODE | ||||
75 | XML_DTD_NODE | ||||
76 | XML_ELEMENT_DECL | ||||
77 | XML_ATTRIBUTE_DECL | ||||
78 | XML_ENTITY_DECL | ||||
79 | XML_NAMESPACE_DECL | ||||
80 | XML_XINCLUDE_END | ||||
81 | XML_XINCLUDE_START | ||||
82 | encodeToUTF8 | ||||
83 | decodeFromUTF8 | ||||
84 | XML_XMLNS_NS | ||||
85 | XML_XML_NS | ||||
86 | )], | ||||
87 | libxml => [qw( | ||||
88 | XML_ELEMENT_NODE | ||||
89 | XML_ATTRIBUTE_NODE | ||||
90 | XML_TEXT_NODE | ||||
91 | XML_CDATA_SECTION_NODE | ||||
92 | XML_ENTITY_REF_NODE | ||||
93 | XML_ENTITY_NODE | ||||
94 | XML_PI_NODE | ||||
95 | XML_COMMENT_NODE | ||||
96 | XML_DOCUMENT_NODE | ||||
97 | XML_DOCUMENT_TYPE_NODE | ||||
98 | XML_DOCUMENT_FRAG_NODE | ||||
99 | XML_NOTATION_NODE | ||||
100 | XML_HTML_DOCUMENT_NODE | ||||
101 | XML_DTD_NODE | ||||
102 | XML_ELEMENT_DECL | ||||
103 | XML_ATTRIBUTE_DECL | ||||
104 | XML_ENTITY_DECL | ||||
105 | XML_NAMESPACE_DECL | ||||
106 | XML_XINCLUDE_END | ||||
107 | XML_XINCLUDE_START | ||||
108 | )], | ||||
109 | encoding => [qw( | ||||
110 | encodeToUTF8 | ||||
111 | decodeFromUTF8 | ||||
112 | )], | ||||
113 | ns => [qw( | ||||
114 | XML_XMLNS_NS | ||||
115 | XML_XML_NS | ||||
116 | )], | ||||
117 | ); | ||||
118 | |||||
119 | @EXPORT_OK = ( | ||||
120 | @{$EXPORT_TAGS{all}}, | ||||
121 | ); | ||||
122 | |||||
123 | @EXPORT = ( | ||||
124 | @{$EXPORT_TAGS{all}}, | ||||
125 | ); | ||||
126 | |||||
127 | #-------------------------------------------------------------------------# | ||||
128 | # initialization of the global variables # | ||||
129 | #-------------------------------------------------------------------------# | ||||
130 | $skipDTD = 0; | ||||
131 | $skipXMLDeclaration = 0; | ||||
132 | $setTagCompression = 0; | ||||
133 | |||||
134 | $MatchCB = undef; | ||||
135 | $ReadCB = undef; | ||||
136 | $OpenCB = undef; | ||||
137 | $CloseCB = undef; | ||||
138 | |||||
139 | # if ($threads::threads) { | ||||
140 | # our $__THREADS_TID = 0; | ||||
141 | # eval q{ | ||||
142 | # use threads::shared; | ||||
143 | # our $__PROXY_NODE_REGISTRY_MUTEX :shared = 0; | ||||
144 | # }; | ||||
145 | # die $@ if $@; | ||||
146 | # } | ||||
147 | #-------------------------------------------------------------------------# | ||||
148 | # bootstrapping # | ||||
149 | #-------------------------------------------------------------------------# | ||||
150 | XSLoader::load( 'XML::LibXML', $VERSION ); | ||||
151 | undef &AUTOLOAD; | ||||
152 | |||||
153 | *encodeToUTF8 = \&XML::LibXML::Common::encodeToUTF8; | ||||
154 | *decodeFromUTF8 = \&XML::LibXML::Common::decodeFromUTF8; | ||||
155 | |||||
156 | } # BEGIN | ||||
157 | |||||
158 | |||||
159 | #-------------------------------------------------------------------------# | ||||
160 | # libxml2 node names (see also XML::LibXML::Common # | ||||
161 | #-------------------------------------------------------------------------# | ||||
162 | use constant XML_ELEMENT_NODE => 1; | ||||
163 | use constant XML_ATTRIBUTE_NODE => 2; | ||||
164 | use constant XML_TEXT_NODE => 3; | ||||
165 | use constant XML_CDATA_SECTION_NODE => 4; | ||||
166 | use constant XML_ENTITY_REF_NODE => 5; | ||||
167 | use constant XML_ENTITY_NODE => 6; | ||||
168 | use constant XML_PI_NODE => 7; | ||||
169 | use constant XML_COMMENT_NODE => 8; | ||||
170 | use constant XML_DOCUMENT_NODE => 9; | ||||
171 | use constant XML_DOCUMENT_TYPE_NODE => 10; | ||||
172 | use constant XML_DOCUMENT_FRAG_NODE => 11; | ||||
173 | use constant XML_NOTATION_NODE => 12; | ||||
174 | use constant XML_HTML_DOCUMENT_NODE => 13; | ||||
175 | use constant XML_DTD_NODE => 14; | ||||
176 | use constant XML_ELEMENT_DECL => 15; | ||||
177 | use constant XML_ATTRIBUTE_DECL => 16; | ||||
178 | use constant XML_ENTITY_DECL => 17; | ||||
179 | use constant XML_NAMESPACE_DECL => 18; | ||||
180 | use constant XML_XINCLUDE_START => 19; | ||||
181 | use constant XML_XINCLUDE_END => 20; | ||||
182 | |||||
183 | |||||
184 | sub import { | ||||
185 | my $package=shift; | ||||
186 | if (grep /^:threads_shared$/, @_) { | ||||
187 | require threads; | ||||
188 | if (!defined($__threads_shared)) { | ||||
189 | if (INIT_THREAD_SUPPORT()) { | ||||
190 | eval q{ | ||||
191 | use threads::shared; | ||||
192 | share($__PROXY_NODE_REGISTRY_MUTEX); | ||||
193 | }; | ||||
194 | if ($@) { # something went wrong | ||||
195 | DISABLE_THREAD_SUPPORT(); # leave the library in a usable state | ||||
196 | die $@; # and die | ||||
197 | } | ||||
198 | $__PROXY_NODE_REGISTRY = XML::LibXML::HashTable->new(); | ||||
199 | $__threads_shared=1; | ||||
200 | } else { | ||||
201 | croak("XML::LibXML or Perl compiled without ithread support!"); | ||||
202 | } | ||||
203 | } elsif (!$__threads_shared) { | ||||
204 | croak("XML::LibXML already loaded without thread support. Too late to enable thread support!"); | ||||
205 | } | ||||
206 | } elsif (defined $XML::LibXML::__loaded) { | ||||
207 | $__threads_shared=0 if not defined $__threads_shared; | ||||
208 | } | ||||
209 | __PACKAGE__->export_to_level(1,$package,grep !/^:threads(_shared)?$/,@_); | ||||
210 | } | ||||
211 | |||||
212 | sub threads_shared_enabled { | ||||
213 | return $__threads_shared ? 1 : 0; | ||||
214 | } | ||||
215 | |||||
216 | # if ($threads::threads) { | ||||
217 | # our $__PROXY_NODE_REGISTRY = XML::LibXML::HashTable->new(); | ||||
218 | # } | ||||
219 | |||||
220 | #-------------------------------------------------------------------------# | ||||
221 | # test exact version (up to patch-level) # | ||||
222 | #-------------------------------------------------------------------------# | ||||
223 | { | ||||
224 | my ($runtime_version) = LIBXML_RUNTIME_VERSION() =~ /^(\d+)/; | ||||
225 | if ( $runtime_version < LIBXML_VERSION ) { | ||||
226 | warn "Warning: XML::LibXML compiled against libxml2 ".LIBXML_VERSION. | ||||
227 | ", but runtime libxml2 is older $runtime_version\n"; | ||||
228 | } | ||||
229 | } | ||||
230 | |||||
231 | |||||
232 | #-------------------------------------------------------------------------# | ||||
233 | # parser flags # | ||||
234 | #-------------------------------------------------------------------------# | ||||
235 | |||||
236 | # Copied directly from http://xmlsoft.org/html/libxml-parser.html#xmlParserOption | ||||
237 | use constant { | ||||
238 | XML_PARSE_RECOVER => 1, # recover on errors | ||||
239 | XML_PARSE_NOENT => 2, # substitute entities | ||||
240 | XML_PARSE_DTDLOAD => 4, # load the external subset | ||||
241 | XML_PARSE_DTDATTR => 8, # default DTD attributes | ||||
242 | XML_PARSE_DTDVALID => 16, # validate with the DTD | ||||
243 | XML_PARSE_NOERROR => 32, # suppress error reports | ||||
244 | XML_PARSE_NOWARNING => 64, # suppress warning reports | ||||
245 | XML_PARSE_PEDANTIC => 128, # pedantic error reporting | ||||
246 | XML_PARSE_NOBLANKS => 256, # remove blank nodes | ||||
247 | XML_PARSE_SAX1 => 512, # use the SAX1 interface internally | ||||
248 | XML_PARSE_XINCLUDE => 1024, # Implement XInclude substitution | ||||
249 | XML_PARSE_NONET => 2048, # Forbid network access | ||||
250 | XML_PARSE_NODICT => 4096, # Do not reuse the context dictionary | ||||
251 | XML_PARSE_NSCLEAN => 8192, # remove redundant namespaces declarations | ||||
252 | XML_PARSE_NOCDATA => 16384, # merge CDATA as text nodes | ||||
253 | XML_PARSE_NOXINCNODE => 32768, # do not generate XINCLUDE START/END nodes | ||||
254 | XML_PARSE_COMPACT => 65536, # compact small text nodes; no modification of the tree allowed afterwards | ||||
255 | # (will possibly crash if you try to modify the tree) | ||||
256 | XML_PARSE_OLD10 => 131072, # parse using XML-1.0 before update 5 | ||||
257 | XML_PARSE_NOBASEFIX => 262144, # do not fixup XINCLUDE xml#base uris | ||||
258 | XML_PARSE_HUGE => 524288, # relax any hardcoded limit from the parser | ||||
259 | XML_PARSE_OLDSAX => 1048576, # parse using SAX2 interface from before 2.7.0 | ||||
260 | HTML_PARSE_RECOVER => (1<<0), # suppress error reports | ||||
261 | HTML_PARSE_NOERROR => (1<<5), # suppress error reports | ||||
262 | }; | ||||
263 | |||||
264 | $XML_LIBXML_PARSE_DEFAULTS = ( XML_PARSE_NODICT ); | ||||
265 | |||||
266 | # this hash is made global so that applications can add names for new | ||||
267 | # libxml2 parser flags as temporary workaround | ||||
268 | |||||
269 | %PARSER_FLAGS = ( | ||||
270 | recover => XML_PARSE_RECOVER, | ||||
271 | expand_entities => XML_PARSE_NOENT, | ||||
272 | load_ext_dtd => XML_PARSE_DTDLOAD, | ||||
273 | complete_attributes => XML_PARSE_DTDATTR, | ||||
274 | validation => XML_PARSE_DTDVALID, | ||||
275 | suppress_errors => XML_PARSE_NOERROR, | ||||
276 | suppress_warnings => XML_PARSE_NOWARNING, | ||||
277 | pedantic_parser => XML_PARSE_PEDANTIC, | ||||
278 | no_blanks => XML_PARSE_NOBLANKS, | ||||
279 | expand_xinclude => XML_PARSE_XINCLUDE, | ||||
280 | xinclude => XML_PARSE_XINCLUDE, | ||||
281 | no_network => XML_PARSE_NONET, | ||||
282 | clean_namespaces => XML_PARSE_NSCLEAN, | ||||
283 | no_cdata => XML_PARSE_NOCDATA, | ||||
284 | no_xinclude_nodes => XML_PARSE_NOXINCNODE, | ||||
285 | old10 => XML_PARSE_OLD10, | ||||
286 | no_base_fix => XML_PARSE_NOBASEFIX, | ||||
287 | huge => XML_PARSE_HUGE, | ||||
288 | oldsax => XML_PARSE_OLDSAX, | ||||
289 | ); | ||||
290 | |||||
291 | my %OUR_FLAGS = ( | ||||
292 | recover => 'XML_LIBXML_RECOVER', | ||||
293 | line_numbers => 'XML_LIBXML_LINENUMBERS', | ||||
294 | URI => 'XML_LIBXML_BASE_URI', | ||||
295 | base_uri => 'XML_LIBXML_BASE_URI', | ||||
296 | gdome => 'XML_LIBXML_GDOME', | ||||
297 | ext_ent_handler => 'ext_ent_handler', | ||||
298 | ); | ||||
299 | |||||
300 | sub _parser_options { | ||||
301 | my ($self, $opts) = @_; | ||||
302 | |||||
303 | # currently dictionaries break XML::LibXML memory management | ||||
304 | |||||
305 | my $flags; | ||||
306 | |||||
307 | if (ref($self)) { | ||||
308 | $flags = ($self->{XML_LIBXML_PARSER_OPTIONS}||0); | ||||
309 | } else { | ||||
310 | $flags = $XML_LIBXML_PARSE_DEFAULTS; # safety precaution | ||||
311 | } | ||||
312 | |||||
313 | my ($key, $value); | ||||
314 | while (($key,$value) = each %$opts) { | ||||
315 | my $f = $PARSER_FLAGS{ $key }; | ||||
316 | if (defined $f) { | ||||
317 | if ($value) { | ||||
318 | $flags |= $f | ||||
319 | } else { | ||||
320 | $flags &= ~$f; | ||||
321 | } | ||||
322 | } elsif ($key eq 'set_parser_flags') { # this can be used to pass flags XML::LibXML does not yet know about | ||||
323 | $flags |= $value; | ||||
324 | } elsif ($key eq 'unset_parser_flags') { | ||||
325 | $flags &= ~$value; | ||||
326 | } | ||||
327 | |||||
328 | } | ||||
329 | return $flags; | ||||
330 | } | ||||
331 | |||||
332 | my %compatibility_flags = ( | ||||
333 | XML_LIBXML_VALIDATION => 'validation', | ||||
334 | XML_LIBXML_EXPAND_ENTITIES => 'expand_entities', | ||||
335 | XML_LIBXML_PEDANTIC => 'pedantic_parser', | ||||
336 | XML_LIBXML_NONET => 'no_network', | ||||
337 | XML_LIBXML_EXT_DTD => 'load_ext_dtd', | ||||
338 | XML_LIBXML_COMPLETE_ATTR => 'complete_attributes', | ||||
339 | XML_LIBXML_EXPAND_XINCLUDE => 'expand_xinclude', | ||||
340 | XML_LIBXML_NSCLEAN => 'clean_namespaces', | ||||
341 | XML_LIBXML_KEEP_BLANKS => 'keep_blanks', | ||||
342 | XML_LIBXML_LINENUMBERS => 'line_numbers', | ||||
343 | ); | ||||
344 | |||||
345 | #-------------------------------------------------------------------------# | ||||
346 | # parser constructor # | ||||
347 | #-------------------------------------------------------------------------# | ||||
348 | |||||
349 | |||||
350 | sub new { | ||||
351 | my $class = shift; | ||||
352 | my $self = bless { | ||||
353 | }, $class; | ||||
354 | if (@_) { | ||||
355 | my %opts = (); | ||||
356 | if (ref($_[0]) eq 'HASH') { | ||||
357 | %opts = %{$_[0]}; | ||||
358 | } else { | ||||
359 | # old interface | ||||
360 | my %args = @_; | ||||
361 | %opts=( | ||||
362 | map { | ||||
363 | (($compatibility_flags{ $_ }||$_) => $args{ $_ }) | ||||
364 | } keys %args | ||||
365 | ); | ||||
366 | } | ||||
367 | # parser flags | ||||
368 | $opts{no_blanks} = !$opts{keep_blanks} if exists($opts{keep_blanks}) and !exists($opts{no_blanks}); | ||||
369 | $opts{load_ext_dtd} = $opts{expand_entities} if exists($opts{expand_entities}) and !exists($opts{load_ext_dtd}); | ||||
370 | |||||
371 | for (keys %OUR_FLAGS) { | ||||
372 | $self->{$OUR_FLAGS{$_}} = delete $opts{$_}; | ||||
373 | } | ||||
374 | $class->load_catalog(delete($opts{catalog})) if $opts{catalog}; | ||||
375 | |||||
376 | $self->{XML_LIBXML_PARSER_OPTIONS} = XML::LibXML->_parser_options(\%opts); | ||||
377 | |||||
378 | # store remaining unknown options directly in $self | ||||
379 | for (keys %opts) { | ||||
380 | $self->{$_}=$opts{$_} unless exists $PARSER_FLAGS{$_}; | ||||
381 | } | ||||
382 | } else { | ||||
383 | $self->{XML_LIBXML_PARSER_OPTIONS} = $XML_LIBXML_PARSE_DEFAULTS; | ||||
384 | } | ||||
385 | if ( defined $self->{Handler} ) { | ||||
386 | $self->set_handler( $self->{Handler} ); | ||||
387 | } | ||||
388 | |||||
389 | $self->{_State_} = 0; | ||||
390 | return $self; | ||||
391 | } | ||||
392 | |||||
393 | sub _clone { | ||||
394 | my ($self)=@_; | ||||
395 | my $new = ref($self)->new({ | ||||
396 | recover => $self->{XML_LIBXML_RECOVER}, | ||||
397 | line_numbers => $self->{XML_LIBXML_LINENUMBERS}, | ||||
398 | base_uri => $self->{XML_LIBXML_BASE_URI}, | ||||
399 | gdome => $self->{XML_LIBXML_GDOME}, | ||||
400 | }); | ||||
401 | # The parser options may contain some options that were zeroed from the | ||||
402 | # defaults so set_parser_flags won't work here. We need to assign them | ||||
403 | # explicitly. | ||||
404 | $new->{XML_LIBXML_PARSER_OPTIONS} = $self->{XML_LIBXML_PARSER_OPTIONS}; | ||||
405 | $new->input_callbacks($self->input_callbacks()); | ||||
406 | return $new; | ||||
407 | } | ||||
408 | |||||
409 | #-------------------------------------------------------------------------# | ||||
410 | # Threads support methods # | ||||
411 | #-------------------------------------------------------------------------# | ||||
412 | |||||
413 | # threads doc says CLONE's API may change in future, which would break | ||||
414 | # an XS method prototype | ||||
415 | sub CLONE { | ||||
416 | if ($XML::LibXML::__threads_shared) { | ||||
417 | XML::LibXML::_CLONE( $_[0] ); | ||||
418 | } | ||||
419 | } | ||||
420 | |||||
421 | sub CLONE_SKIP { | ||||
422 | return $XML::LibXML::__threads_shared ? 0 : 1; | ||||
423 | } | ||||
424 | |||||
425 | sub __proxy_registry { | ||||
426 | my ($class)=caller; | ||||
427 | die "This version of $class uses API of XML::LibXML 1.66 which is not compatible with XML::LibXML $VERSION. Please upgrade $class!\n"; | ||||
428 | } | ||||
429 | |||||
430 | #-------------------------------------------------------------------------# | ||||
431 | # DOM Level 2 document constructor # | ||||
432 | #-------------------------------------------------------------------------# | ||||
433 | |||||
434 | sub createDocument { | ||||
435 | my $self = shift; | ||||
436 | if (!@_ or $_[0] =~ m/^\d\.\d$/) { | ||||
437 | # for backward compatibility | ||||
438 | return XML::LibXML::Document->new(@_); | ||||
439 | } | ||||
440 | else { | ||||
441 | # DOM API: createDocument(namespaceURI, qualifiedName, doctype?) | ||||
442 | my $doc = XML::LibXML::Document-> new; | ||||
443 | my $el = $doc->createElementNS(shift, shift); | ||||
444 | $doc->setDocumentElement($el); | ||||
445 | $doc->setExternalSubset(shift) if @_; | ||||
446 | return $doc; | ||||
447 | } | ||||
448 | } | ||||
449 | |||||
450 | #-------------------------------------------------------------------------# | ||||
451 | # callback functions # | ||||
452 | #-------------------------------------------------------------------------# | ||||
453 | |||||
454 | sub externalEntityLoader(&) | ||||
455 | { | ||||
456 | return _externalEntityLoader($_[0]); | ||||
457 | } | ||||
458 | |||||
459 | sub input_callbacks { | ||||
460 | my $self = shift; | ||||
461 | my $icbclass = shift; | ||||
462 | |||||
463 | if ( defined $icbclass ) { | ||||
464 | $self->{XML_LIBXML_CALLBACK_STACK} = $icbclass; | ||||
465 | } | ||||
466 | return $self->{XML_LIBXML_CALLBACK_STACK}; | ||||
467 | } | ||||
468 | |||||
469 | sub match_callback { | ||||
470 | my $self = shift; | ||||
471 | if ( ref $self ) { | ||||
472 | if ( scalar @_ ) { | ||||
473 | $self->{XML_LIBXML_MATCH_CB} = shift; | ||||
474 | $self->{XML_LIBXML_CALLBACK_STACK} = undef; | ||||
475 | } | ||||
476 | return $self->{XML_LIBXML_MATCH_CB}; | ||||
477 | } | ||||
478 | else { | ||||
479 | $MatchCB = shift if scalar @_; | ||||
480 | return $MatchCB; | ||||
481 | } | ||||
482 | } | ||||
483 | |||||
484 | sub read_callback { | ||||
485 | my $self = shift; | ||||
486 | if ( ref $self ) { | ||||
487 | if ( scalar @_ ) { | ||||
488 | $self->{XML_LIBXML_READ_CB} = shift; | ||||
489 | $self->{XML_LIBXML_CALLBACK_STACK} = undef; | ||||
490 | } | ||||
491 | return $self->{XML_LIBXML_READ_CB}; | ||||
492 | } | ||||
493 | else { | ||||
494 | $ReadCB = shift if scalar @_; | ||||
495 | return $ReadCB; | ||||
496 | } | ||||
497 | } | ||||
498 | |||||
499 | sub close_callback { | ||||
500 | my $self = shift; | ||||
501 | if ( ref $self ) { | ||||
502 | if ( scalar @_ ) { | ||||
503 | $self->{XML_LIBXML_CLOSE_CB} = shift; | ||||
504 | $self->{XML_LIBXML_CALLBACK_STACK} = undef; | ||||
505 | } | ||||
506 | return $self->{XML_LIBXML_CLOSE_CB}; | ||||
507 | } | ||||
508 | else { | ||||
509 | $CloseCB = shift if scalar @_; | ||||
510 | return $CloseCB; | ||||
511 | } | ||||
512 | } | ||||
513 | |||||
514 | sub open_callback { | ||||
515 | my $self = shift; | ||||
516 | if ( ref $self ) { | ||||
517 | if ( scalar @_ ) { | ||||
518 | $self->{XML_LIBXML_OPEN_CB} = shift; | ||||
519 | $self->{XML_LIBXML_CALLBACK_STACK} = undef; | ||||
520 | } | ||||
521 | return $self->{XML_LIBXML_OPEN_CB}; | ||||
522 | } | ||||
523 | else { | ||||
524 | $OpenCB = shift if scalar @_; | ||||
525 | return $OpenCB; | ||||
526 | } | ||||
527 | } | ||||
528 | |||||
529 | sub callbacks { | ||||
530 | my $self = shift; | ||||
531 | if ( ref $self ) { | ||||
532 | if (@_) { | ||||
533 | my ($match, $open, $read, $close) = @_; | ||||
534 | @{$self}{qw(XML_LIBXML_MATCH_CB XML_LIBXML_OPEN_CB XML_LIBXML_READ_CB XML_LIBXML_CLOSE_CB)} = ($match, $open, $read, $close); | ||||
535 | $self->{XML_LIBXML_CALLBACK_STACK} = undef; | ||||
536 | } | ||||
537 | else { | ||||
538 | return @{$self}{qw(XML_LIBXML_MATCH_CB XML_LIBXML_OPEN_CB XML_LIBXML_READ_CB XML_LIBXML_CLOSE_CB)}; | ||||
539 | } | ||||
540 | } | ||||
541 | else { | ||||
542 | if (@_) { | ||||
543 | ( $MatchCB, $OpenCB, $ReadCB, $CloseCB ) = @_; | ||||
544 | } | ||||
545 | else { | ||||
546 | return ( $MatchCB, $OpenCB, $ReadCB, $CloseCB ); | ||||
547 | } | ||||
548 | } | ||||
549 | } | ||||
550 | |||||
551 | #-------------------------------------------------------------------------# | ||||
552 | # internal member variable manipulation # | ||||
553 | #-------------------------------------------------------------------------# | ||||
554 | sub __parser_option { | ||||
555 | my ($self, $opt) = @_; | ||||
556 | if (@_>2) { | ||||
557 | if ($_[2]) { | ||||
558 | $self->{XML_LIBXML_PARSER_OPTIONS} |= $opt; | ||||
559 | return 1; | ||||
560 | } else { | ||||
561 | $self->{XML_LIBXML_PARSER_OPTIONS} &= ~$opt; | ||||
562 | return 0; | ||||
563 | } | ||||
564 | } else { | ||||
565 | return ($self->{XML_LIBXML_PARSER_OPTIONS} & $opt) ? 1 : 0; | ||||
566 | } | ||||
567 | } | ||||
568 | |||||
569 | sub option_exists { | ||||
570 | my ($self,$name)=@_; | ||||
571 | return ($PARSER_FLAGS{$name} || $OUR_FLAGS{$name}) ? 1 : 0; | ||||
572 | } | ||||
573 | sub get_option { | ||||
574 | my ($self,$name)=@_; | ||||
575 | my $flag = $OUR_FLAGS{$name}; | ||||
576 | return $self->{$flag} if $flag; | ||||
577 | $flag = $PARSER_FLAGS{$name}; | ||||
578 | return $self->__parser_option($flag) if $flag; | ||||
579 | warn "XML::LibXML::get_option: unknown parser option $name\n"; | ||||
580 | return undef; | ||||
581 | } | ||||
582 | sub set_option { | ||||
583 | my ($self,$name,$value)=@_; | ||||
584 | my $flag = $OUR_FLAGS{$name}; | ||||
585 | return ($self->{$flag}=$value) if $flag; | ||||
586 | $flag = $PARSER_FLAGS{$name}; | ||||
587 | return $self->__parser_option($flag,$value) if $flag; | ||||
588 | warn "XML::LibXML::get_option: unknown parser option $name\n"; | ||||
589 | return undef; | ||||
590 | } | ||||
591 | sub set_options { | ||||
592 | my $self=shift; | ||||
593 | my $opts; | ||||
594 | if (@_==1 and ref($_[0]) eq 'HASH') { | ||||
595 | $opts = $_[0]; | ||||
596 | } elsif (@_ % 2 == 0) { | ||||
597 | $opts={@_}; | ||||
598 | } else { | ||||
599 | croak("Odd number of elements passed to set_options"); | ||||
600 | } | ||||
601 | $self->set_option($_=>$opts->{$_}) foreach keys %$opts; | ||||
602 | return; | ||||
603 | } | ||||
604 | |||||
605 | sub validation { | ||||
606 | my $self = shift; | ||||
607 | return $self->__parser_option(XML_PARSE_DTDVALID,@_); | ||||
608 | } | ||||
609 | |||||
610 | sub recover { | ||||
611 | my $self = shift; | ||||
612 | if (scalar @_) { | ||||
613 | $self->{XML_LIBXML_RECOVER} = $_[0]; | ||||
614 | $self->__parser_option(XML_PARSE_RECOVER,@_); | ||||
615 | } | ||||
616 | return $self->{XML_LIBXML_RECOVER}; | ||||
617 | } | ||||
618 | |||||
619 | sub recover_silently { | ||||
620 | my $self = shift; | ||||
621 | my $arg = shift; | ||||
622 | if ( defined($arg) ) | ||||
623 | { | ||||
624 | $self->recover(($arg == 1) ? 2 : $arg); | ||||
625 | } | ||||
626 | return (($self->recover()||0) == 2) ? 1 : 0; | ||||
627 | } | ||||
628 | |||||
629 | sub expand_entities { | ||||
630 | my $self = shift; | ||||
631 | if (scalar(@_) and $_[0]) { | ||||
632 | return $self->__parser_option(XML_PARSE_NOENT | XML_PARSE_DTDLOAD,1); | ||||
633 | } | ||||
634 | return $self->__parser_option(XML_PARSE_NOENT,@_); | ||||
635 | } | ||||
636 | |||||
637 | sub keep_blanks { | ||||
638 | my $self = shift; | ||||
639 | my @args; # we have to negate the argument and return negated value, since | ||||
640 | # the actual flag is no_blanks | ||||
641 | if (scalar @_) { | ||||
642 | @args=($_[0] ? 0 : 1); | ||||
643 | } | ||||
644 | return $self->__parser_option(XML_PARSE_NOBLANKS,@args) ? 0 : 1; | ||||
645 | } | ||||
646 | |||||
647 | sub pedantic_parser { | ||||
648 | my $self = shift; | ||||
649 | return $self->__parser_option(XML_PARSE_PEDANTIC,@_); | ||||
650 | } | ||||
651 | |||||
652 | sub line_numbers { | ||||
653 | my $self = shift; | ||||
654 | $self->{XML_LIBXML_LINENUMBERS} = shift if scalar @_; | ||||
655 | return $self->{XML_LIBXML_LINENUMBERS}; | ||||
656 | } | ||||
657 | |||||
658 | sub no_network { | ||||
659 | my $self = shift; | ||||
660 | return $self->__parser_option(XML_PARSE_NONET,@_); | ||||
661 | } | ||||
662 | |||||
663 | sub load_ext_dtd { | ||||
664 | my $self = shift; | ||||
665 | return $self->__parser_option(XML_PARSE_DTDLOAD,@_); | ||||
666 | } | ||||
667 | |||||
668 | sub complete_attributes { | ||||
669 | my $self = shift; | ||||
670 | return $self->__parser_option(XML_PARSE_DTDATTR,@_); | ||||
671 | } | ||||
672 | |||||
673 | sub expand_xinclude { | ||||
674 | my $self = shift; | ||||
675 | return $self->__parser_option(XML_PARSE_XINCLUDE,@_); | ||||
676 | } | ||||
677 | |||||
678 | sub base_uri { | ||||
679 | my $self = shift; | ||||
680 | $self->{XML_LIBXML_BASE_URI} = shift if scalar @_; | ||||
681 | return $self->{XML_LIBXML_BASE_URI}; | ||||
682 | } | ||||
683 | |||||
684 | sub gdome_dom { | ||||
685 | my $self = shift; | ||||
686 | $self->{XML_LIBXML_GDOME} = shift if scalar @_; | ||||
687 | return $self->{XML_LIBXML_GDOME}; | ||||
688 | } | ||||
689 | |||||
690 | sub clean_namespaces { | ||||
691 | my $self = shift; | ||||
692 | return $self->__parser_option(XML_PARSE_NSCLEAN,@_); | ||||
693 | } | ||||
694 | |||||
695 | #-------------------------------------------------------------------------# | ||||
696 | # set the optional SAX(2) handler # | ||||
697 | #-------------------------------------------------------------------------# | ||||
698 | sub set_handler { | ||||
699 | my $self = shift; | ||||
700 | if ( defined $_[0] ) { | ||||
701 | $self->{HANDLER} = $_[0]; | ||||
702 | |||||
703 | $self->{SAX_ELSTACK} = []; | ||||
704 | $self->{SAX} = {State => 0}; | ||||
705 | } | ||||
706 | else { | ||||
707 | # undef SAX handling | ||||
708 | $self->{SAX_ELSTACK} = []; | ||||
709 | delete $self->{HANDLER}; | ||||
710 | delete $self->{SAX}; | ||||
711 | } | ||||
712 | } | ||||
713 | |||||
714 | #-------------------------------------------------------------------------# | ||||
715 | # helper functions # | ||||
716 | #-------------------------------------------------------------------------# | ||||
717 | sub _auto_expand { | ||||
718 | my ( $self, $result, $uri ) = @_; | ||||
719 | |||||
720 | $result->setBaseURI( $uri ) if defined $uri; | ||||
721 | |||||
722 | if ( $self->expand_xinclude ) { | ||||
723 | $self->{_State_} = 1; | ||||
724 | eval { $self->processXIncludes($result); }; | ||||
725 | my $err = $@; | ||||
726 | $self->{_State_} = 0; | ||||
727 | if ($err) { | ||||
728 | $self->_cleanup_callbacks(); | ||||
729 | $result = undef; | ||||
730 | croak $err; | ||||
731 | } | ||||
732 | } | ||||
733 | return $result; | ||||
734 | } | ||||
735 | |||||
736 | sub _init_callbacks { | ||||
737 | my $self = shift; | ||||
738 | my $icb = $self->{XML_LIBXML_CALLBACK_STACK}; | ||||
739 | unless ( defined $icb ) { | ||||
740 | $self->{XML_LIBXML_CALLBACK_STACK} = XML::LibXML::InputCallback->new(); | ||||
741 | $icb = $self->{XML_LIBXML_CALLBACK_STACK}; | ||||
742 | } | ||||
743 | |||||
744 | $icb->init_callbacks($self); | ||||
745 | } | ||||
746 | |||||
747 | sub _cleanup_callbacks { | ||||
748 | my $self = shift; | ||||
749 | $self->{XML_LIBXML_CALLBACK_STACK}->cleanup_callbacks(); | ||||
750 | } | ||||
751 | |||||
752 | sub __read { | ||||
753 | read($_[0], $_[1], $_[2]); | ||||
754 | } | ||||
755 | |||||
756 | sub __write { | ||||
757 | if ( ref( $_[0] ) ) { | ||||
758 | $_[0]->write( $_[1], $_[2] ); | ||||
759 | } | ||||
760 | else { | ||||
761 | $_[0]->write( $_[1] ); | ||||
762 | } | ||||
763 | } | ||||
764 | |||||
765 | sub load_xml { | ||||
766 | my $class_or_self = shift; | ||||
767 | my %args = map { ref($_) eq 'HASH' ? (%$_) : $_ } @_; | ||||
768 | |||||
769 | my $URI = delete($args{URI}); | ||||
770 | $URI = "$URI" if defined $URI; # stringify in case it is an URI object | ||||
771 | my $parser; | ||||
772 | if (ref($class_or_self)) { | ||||
773 | $parser = $class_or_self->_clone(); | ||||
774 | $parser->{XML_LIBXML_PARSER_OPTIONS} = $parser->_parser_options(\%args); | ||||
775 | } else { | ||||
776 | $parser = $class_or_self->new(\%args); | ||||
777 | } | ||||
778 | my $dom; | ||||
779 | if ( defined $args{location} ) { | ||||
780 | $dom = $parser->parse_file( "$args{location}" ); | ||||
781 | } | ||||
782 | elsif ( defined $args{string} ) { | ||||
783 | $dom = $parser->parse_string( $args{string}, $URI ); | ||||
784 | } | ||||
785 | elsif ( defined $args{IO} ) { | ||||
786 | $dom = $parser->parse_fh( $args{IO}, $URI ); | ||||
787 | } | ||||
788 | else { | ||||
789 | croak("XML::LibXML->load: specify location, string, or IO"); | ||||
790 | } | ||||
791 | return $dom; | ||||
792 | } | ||||
793 | |||||
794 | sub load_html { | ||||
795 | my ($class_or_self) = shift; | ||||
796 | my %args = map { ref($_) eq 'HASH' ? (%$_) : $_ } @_; | ||||
797 | my $URI = delete($args{URI}); | ||||
798 | $URI = "$URI" if defined $URI; # stringify in case it is an URI object | ||||
799 | my $parser; | ||||
800 | if (ref($class_or_self)) { | ||||
801 | $parser = $class_or_self->_clone(); | ||||
802 | } else { | ||||
803 | $parser = $class_or_self->new(); | ||||
804 | } | ||||
805 | my $dom; | ||||
806 | if ( defined $args{location} ) { | ||||
807 | $dom = $parser->parse_html_file( "$args{location}", \%args ); | ||||
808 | } | ||||
809 | elsif ( defined $args{string} ) { | ||||
810 | $dom = $parser->parse_html_string( $args{string}, \%args ); | ||||
811 | } | ||||
812 | elsif ( defined $args{IO} ) { | ||||
813 | $dom = $parser->parse_html_fh( $args{IO}, \%args ); | ||||
814 | } | ||||
815 | else { | ||||
816 | croak("XML::LibXML->load: specify location, string, or IO"); | ||||
817 | } | ||||
818 | return $dom; | ||||
819 | } | ||||
820 | |||||
821 | #-------------------------------------------------------------------------# | ||||
822 | # parsing functions # | ||||
823 | #-------------------------------------------------------------------------# | ||||
824 | # all parsing functions handle normal as SAX parsing at the same time. | ||||
825 | # note that SAX parsing is handled incomplete! use XML::LibXML::SAX for | ||||
826 | # complete parsing sequences | ||||
827 | #-------------------------------------------------------------------------# | ||||
828 | sub parse_string { | ||||
829 | my $self = shift; | ||||
830 | croak("parse_string is not a class method! Create a parser object with XML::LibXML->new first!") unless ref $self; | ||||
831 | croak("parse already in progress") if $self->{_State_}; | ||||
832 | |||||
833 | unless ( defined $_[0] and length $_[0] ) { | ||||
834 | croak("Empty String"); | ||||
835 | } | ||||
836 | |||||
837 | $self->{_State_} = 1; | ||||
838 | my $result; | ||||
839 | |||||
840 | $self->_init_callbacks(); | ||||
841 | |||||
842 | if ( defined $self->{SAX} ) { | ||||
843 | my $string = shift; | ||||
844 | $self->{SAX_ELSTACK} = []; | ||||
845 | eval { $result = $self->_parse_sax_string($string); }; | ||||
846 | my $err = $@; | ||||
847 | $self->{_State_} = 0; | ||||
848 | if ($err) { | ||||
849 | chomp $err unless ref $err; | ||||
850 | $self->_cleanup_callbacks(); | ||||
851 | croak $err; | ||||
852 | } | ||||
853 | } | ||||
854 | else { | ||||
855 | eval { $result = $self->_parse_string( @_ ); }; | ||||
856 | |||||
857 | my $err = $@; | ||||
858 | $self->{_State_} = 0; | ||||
859 | if ($err) { | ||||
860 | chomp $err unless ref $err; | ||||
861 | $self->_cleanup_callbacks(); | ||||
862 | croak $err; | ||||
863 | } | ||||
864 | |||||
865 | $result = $self->_auto_expand( $result, $self->{XML_LIBXML_BASE_URI} ); | ||||
866 | } | ||||
867 | $self->_cleanup_callbacks(); | ||||
868 | |||||
869 | return $result; | ||||
870 | } | ||||
871 | |||||
872 | sub parse_fh { | ||||
873 | my $self = shift; | ||||
874 | croak("parse_fh is not a class method! Create a parser object with XML::LibXML->new first!") unless ref $self; | ||||
875 | croak("parse already in progress") if $self->{_State_}; | ||||
876 | $self->{_State_} = 1; | ||||
877 | my $result; | ||||
878 | |||||
879 | $self->_init_callbacks(); | ||||
880 | |||||
881 | if ( defined $self->{SAX} ) { | ||||
882 | $self->{SAX_ELSTACK} = []; | ||||
883 | eval { $self->_parse_sax_fh( @_ ); }; | ||||
884 | my $err = $@; | ||||
885 | $self->{_State_} = 0; | ||||
886 | if ($err) { | ||||
887 | chomp $err unless ref $err; | ||||
888 | $self->_cleanup_callbacks(); | ||||
889 | croak $err; | ||||
890 | } | ||||
891 | } | ||||
892 | else { | ||||
893 | eval { $result = $self->_parse_fh( @_ ); }; | ||||
894 | my $err = $@; | ||||
895 | $self->{_State_} = 0; | ||||
896 | if ($err) { | ||||
897 | chomp $err unless ref $err; | ||||
898 | $self->_cleanup_callbacks(); | ||||
899 | croak $err; | ||||
900 | } | ||||
901 | |||||
902 | $result = $self->_auto_expand( $result, $self->{XML_LIBXML_BASE_URI} ); | ||||
903 | } | ||||
904 | |||||
905 | $self->_cleanup_callbacks(); | ||||
906 | |||||
907 | return $result; | ||||
908 | } | ||||
909 | |||||
910 | sub parse_file { | ||||
911 | my $self = shift; | ||||
912 | croak("parse_file is not a class method! Create a parser object with XML::LibXML->new first!") unless ref $self; | ||||
913 | croak("parse already in progress") if $self->{_State_}; | ||||
914 | |||||
915 | $self->{_State_} = 1; | ||||
916 | my $result; | ||||
917 | |||||
918 | $self->_init_callbacks(); | ||||
919 | |||||
920 | if ( defined $self->{SAX} ) { | ||||
921 | $self->{SAX_ELSTACK} = []; | ||||
922 | eval { $self->_parse_sax_file( @_ ); }; | ||||
923 | my $err = $@; | ||||
924 | $self->{_State_} = 0; | ||||
925 | if ($err) { | ||||
926 | chomp $err unless ref $err; | ||||
927 | $self->_cleanup_callbacks(); | ||||
928 | croak $err; | ||||
929 | } | ||||
930 | } | ||||
931 | else { | ||||
932 | eval { $result = $self->_parse_file(@_); }; | ||||
933 | my $err = $@; | ||||
934 | $self->{_State_} = 0; | ||||
935 | if ($err) { | ||||
936 | chomp $err unless ref $err; | ||||
937 | $self->_cleanup_callbacks(); | ||||
938 | croak $err; | ||||
939 | } | ||||
940 | |||||
941 | $result = $self->_auto_expand( $result ); | ||||
942 | } | ||||
943 | $self->_cleanup_callbacks(); | ||||
944 | |||||
945 | return $result; | ||||
946 | } | ||||
947 | |||||
948 | sub parse_xml_chunk { | ||||
949 | my $self = shift; | ||||
950 | # max 2 parameter: | ||||
951 | # 1: the chunk | ||||
952 | # 2: the encoding of the string | ||||
953 | croak("parse_xml_chunk is not a class method! Create a parser object with XML::LibXML->new first!") unless ref $self; | ||||
954 | croak("parse already in progress") if $self->{_State_}; my $result; | ||||
955 | |||||
956 | unless ( defined $_[0] and length $_[0] ) { | ||||
957 | croak("Empty String"); | ||||
958 | } | ||||
959 | |||||
960 | $self->{_State_} = 1; | ||||
961 | |||||
962 | $self->_init_callbacks(); | ||||
963 | |||||
964 | if ( defined $self->{SAX} ) { | ||||
965 | eval { | ||||
966 | $self->_parse_sax_xml_chunk( @_ ); | ||||
967 | |||||
968 | # this is required for XML::GenericChunk. | ||||
969 | # in normal case is_filter is not defined, an thus the parsing | ||||
970 | # will be terminated. in case of a SAX filter the parsing is not | ||||
971 | # finished at that state. therefore we must not reset the parsing | ||||
972 | unless ( $self->{IS_FILTER} ) { | ||||
973 | $result = $self->{HANDLER}->end_document(); | ||||
974 | } | ||||
975 | }; | ||||
976 | } | ||||
977 | else { | ||||
978 | eval { $result = $self->_parse_xml_chunk( @_ ); }; | ||||
979 | } | ||||
980 | |||||
981 | $self->_cleanup_callbacks(); | ||||
982 | |||||
983 | my $err = $@; | ||||
984 | $self->{_State_} = 0; | ||||
985 | if ($err) { | ||||
986 | chomp $err unless ref $err; | ||||
987 | croak $err; | ||||
988 | } | ||||
989 | |||||
990 | return $result; | ||||
991 | } | ||||
992 | |||||
993 | sub parse_balanced_chunk { | ||||
994 | my $self = shift; | ||||
995 | $self->_init_callbacks(); | ||||
996 | my $rv; | ||||
997 | eval { | ||||
998 | $rv = $self->parse_xml_chunk( @_ ); | ||||
999 | }; | ||||
1000 | my $err = $@; | ||||
1001 | $self->_cleanup_callbacks(); | ||||
1002 | if ( $err ) { | ||||
1003 | chomp $err unless ref $err; | ||||
1004 | croak $err; | ||||
1005 | } | ||||
1006 | return $rv | ||||
1007 | } | ||||
1008 | |||||
1009 | # java style | ||||
1010 | sub processXIncludes { | ||||
1011 | my $self = shift; | ||||
1012 | my $doc = shift; | ||||
1013 | my $opts = shift; | ||||
1014 | my $options = $self->_parser_options($opts); | ||||
1015 | if ( $self->{_State_} != 1 ) { | ||||
1016 | $self->_init_callbacks(); | ||||
1017 | } | ||||
1018 | my $rv; | ||||
1019 | eval { | ||||
1020 | $rv = $self->_processXIncludes($doc || " ", $options); | ||||
1021 | }; | ||||
1022 | my $err = $@; | ||||
1023 | if ( $self->{_State_} != 1 ) { | ||||
1024 | $self->_cleanup_callbacks(); | ||||
1025 | } | ||||
1026 | |||||
1027 | if ( $err ) { | ||||
1028 | chomp $err unless ref $err; | ||||
1029 | croak $err; | ||||
1030 | } | ||||
1031 | return $rv; | ||||
1032 | } | ||||
1033 | |||||
1034 | # perl style | ||||
1035 | sub process_xincludes { | ||||
1036 | my $self = shift; | ||||
1037 | my $doc = shift; | ||||
1038 | my $opts = shift; | ||||
1039 | my $options = $self->_parser_options($opts); | ||||
1040 | |||||
1041 | my $rv; | ||||
1042 | $self->_init_callbacks(); | ||||
1043 | eval { | ||||
1044 | $rv = $self->_processXIncludes($doc || " ", $options); | ||||
1045 | }; | ||||
1046 | my $err = $@; | ||||
1047 | $self->_cleanup_callbacks(); | ||||
1048 | if ( $err ) { | ||||
1049 | chomp $err unless ref $err; | ||||
1050 | croak $@; | ||||
1051 | } | ||||
1052 | return $rv; | ||||
1053 | } | ||||
1054 | |||||
1055 | #-------------------------------------------------------------------------# | ||||
1056 | # HTML parsing functions # | ||||
1057 | #-------------------------------------------------------------------------# | ||||
1058 | |||||
1059 | sub _html_options { | ||||
1060 | my ($self,$opts)=@_; | ||||
1061 | $opts = {} unless ref $opts; | ||||
1062 | # return (undef,undef) unless ref $opts; | ||||
1063 | my $flags = 0; | ||||
1064 | { | ||||
1065 | my $recover = exists $opts->{recover} ? $opts->{recover} : $self->recover; | ||||
1066 | |||||
1067 | if ($recover) | ||||
1068 | { | ||||
1069 | $flags |= HTML_PARSE_RECOVER; | ||||
1070 | if ($recover == 2) | ||||
1071 | { | ||||
1072 | $flags |= HTML_PARSE_NOERROR; | ||||
1073 | } | ||||
1074 | } | ||||
1075 | } | ||||
1076 | |||||
1077 | $flags |= 4 if $opts->{no_defdtd}; # default is ON: injects DTD as needed | ||||
1078 | $flags |= 32 if exists $opts->{suppress_errors} ? $opts->{suppress_errors} : $self->get_option('suppress_errors'); | ||||
1079 | # This is to fix https://rt.cpan.org/Ticket/Display.html?id=58024 : | ||||
1080 | # <quote> | ||||
1081 | # In XML::LibXML, warnings are not suppressed when specifying the recover | ||||
1082 | # or recover_silently flags as per the following excerpt from the manpage: | ||||
1083 | # </quote> | ||||
1084 | if ($self->recover_silently) | ||||
1085 | { | ||||
1086 | $flags |= 32; | ||||
1087 | } | ||||
1088 | $flags |= 64 if $opts->{suppress_warnings}; | ||||
1089 | $flags |= 128 if exists $opts->{pedantic_parser} ? $opts->{pedantic_parser} : $self->pedantic_parser; | ||||
1090 | $flags |= 256 if exists $opts->{no_blanks} ? $opts->{no_blanks} : !$self->keep_blanks; | ||||
1091 | $flags |= 2048 if exists $opts->{no_network} ? $opts->{no_network} : !$self->no_network; | ||||
1092 | $flags |= 16384 if $opts->{no_cdata}; | ||||
1093 | $flags |= 65536 if $opts->{compact}; # compact small text nodes; no modification | ||||
1094 | # of the tree allowed afterwards | ||||
1095 | # (WILL possibly CRASH IF YOU try to MODIFY THE TREE) | ||||
1096 | $flags |= 524288 if $opts->{huge}; # relax any hardcoded limit from the parser | ||||
1097 | $flags |= 1048576 if $opts->{oldsax}; # parse using SAX2 interface from before 2.7.0 | ||||
1098 | |||||
1099 | return ($opts->{URI},$opts->{encoding},$flags); | ||||
1100 | } | ||||
1101 | |||||
1102 | sub parse_html_string { | ||||
1103 | my ($self,$str,$opts) = @_; | ||||
1104 | croak("parse_html_string is not a class method! Create a parser object with XML::LibXML->new first!") unless ref $self; | ||||
1105 | croak("parse already in progress") if $self->{_State_}; | ||||
1106 | |||||
1107 | unless ( defined $str and length $str ) { | ||||
1108 | croak("Empty String"); | ||||
1109 | } | ||||
1110 | $self->{_State_} = 1; | ||||
1111 | my $result; | ||||
1112 | |||||
1113 | $self->_init_callbacks(); | ||||
1114 | eval { | ||||
1115 | $result = $self->_parse_html_string( $str, | ||||
1116 | $self->_html_options($opts) | ||||
1117 | ); | ||||
1118 | }; | ||||
1119 | my $err = $@; | ||||
1120 | $self->{_State_} = 0; | ||||
1121 | if ($err) { | ||||
1122 | chomp $err unless ref $err; | ||||
1123 | $self->_cleanup_callbacks(); | ||||
1124 | croak $err; | ||||
1125 | } | ||||
1126 | |||||
1127 | $self->_cleanup_callbacks(); | ||||
1128 | |||||
1129 | return $result; | ||||
1130 | } | ||||
1131 | |||||
1132 | sub parse_html_file { | ||||
1133 | my ($self,$file,$opts) = @_; | ||||
1134 | croak("parse_html_file is not a class method! Create a parser object with XML::LibXML->new first!") unless ref $self; | ||||
1135 | croak("parse already in progress") if $self->{_State_}; | ||||
1136 | $self->{_State_} = 1; | ||||
1137 | my $result; | ||||
1138 | |||||
1139 | $self->_init_callbacks(); | ||||
1140 | eval { $result = $self->_parse_html_file($file, | ||||
1141 | $self->_html_options($opts) | ||||
1142 | ); }; | ||||
1143 | my $err = $@; | ||||
1144 | $self->{_State_} = 0; | ||||
1145 | if ($err) { | ||||
1146 | chomp $err unless ref $err; | ||||
1147 | $self->_cleanup_callbacks(); | ||||
1148 | croak $err; | ||||
1149 | } | ||||
1150 | |||||
1151 | $self->_cleanup_callbacks(); | ||||
1152 | |||||
1153 | return $result; | ||||
1154 | } | ||||
1155 | |||||
1156 | sub parse_html_fh { | ||||
1157 | my ($self,$fh,$opts) = @_; | ||||
1158 | croak("parse_html_fh is not a class method! Create a parser object with XML::LibXML->new first!") unless ref $self; | ||||
1159 | croak("parse already in progress") if $self->{_State_}; | ||||
1160 | $self->{_State_} = 1; | ||||
1161 | |||||
1162 | my $result; | ||||
1163 | $self->_init_callbacks(); | ||||
1164 | eval { $result = $self->_parse_html_fh( $fh, | ||||
1165 | $self->_html_options($opts) | ||||
1166 | ); }; | ||||
1167 | my $err = $@; | ||||
1168 | $self->{_State_} = 0; | ||||
1169 | if ($err) { | ||||
1170 | chomp $err unless ref $err; | ||||
1171 | $self->_cleanup_callbacks(); | ||||
1172 | croak $err; | ||||
1173 | } | ||||
1174 | $self->_cleanup_callbacks(); | ||||
1175 | |||||
1176 | return $result; | ||||
1177 | } | ||||
1178 | |||||
1179 | #-------------------------------------------------------------------------# | ||||
1180 | # push parser interface # | ||||
1181 | #-------------------------------------------------------------------------# | ||||
1182 | sub init_push { | ||||
1183 | my $self = shift; | ||||
1184 | |||||
1185 | if ( defined $self->{CONTEXT} ) { | ||||
1186 | delete $self->{CONTEXT}; | ||||
1187 | } | ||||
1188 | |||||
1189 | if ( defined $self->{SAX} ) { | ||||
1190 | $self->{CONTEXT} = $self->_start_push(1); | ||||
1191 | } | ||||
1192 | else { | ||||
1193 | $self->{CONTEXT} = $self->_start_push(0); | ||||
1194 | } | ||||
1195 | } | ||||
1196 | |||||
1197 | sub push { | ||||
1198 | my $self = shift; | ||||
1199 | |||||
1200 | $self->_init_callbacks(); | ||||
1201 | |||||
1202 | if ( not defined $self->{CONTEXT} ) { | ||||
1203 | $self->init_push(); | ||||
1204 | } | ||||
1205 | |||||
1206 | eval { | ||||
1207 | foreach ( @_ ) { | ||||
1208 | $self->_push( $self->{CONTEXT}, $_ ); | ||||
1209 | } | ||||
1210 | }; | ||||
1211 | my $err = $@; | ||||
1212 | $self->_cleanup_callbacks(); | ||||
1213 | if ( $err ) { | ||||
1214 | chomp $err unless ref $err; | ||||
1215 | croak $err; | ||||
1216 | } | ||||
1217 | } | ||||
1218 | |||||
1219 | # this function should be promoted! | ||||
1220 | # the reason is because libxml2 uses xmlParseChunk() for this purpose! | ||||
1221 | sub parse_chunk { | ||||
1222 | my $self = shift; | ||||
1223 | my $chunk = shift; | ||||
1224 | my $terminate = shift; | ||||
1225 | |||||
1226 | if ( not defined $self->{CONTEXT} ) { | ||||
1227 | $self->init_push(); | ||||
1228 | } | ||||
1229 | |||||
1230 | if ( defined $chunk and length $chunk ) { | ||||
1231 | $self->_push( $self->{CONTEXT}, $chunk ); | ||||
1232 | } | ||||
1233 | |||||
1234 | if ( $terminate ) { | ||||
1235 | return $self->finish_push(); | ||||
1236 | } | ||||
1237 | } | ||||
1238 | |||||
1239 | |||||
1240 | sub finish_push { | ||||
1241 | my $self = shift; | ||||
1242 | my $restore = shift || 0; | ||||
1243 | return undef unless defined $self->{CONTEXT}; | ||||
1244 | |||||
1245 | my $retval; | ||||
1246 | |||||
1247 | if ( defined $self->{SAX} ) { | ||||
1248 | eval { | ||||
1249 | $self->_end_sax_push( $self->{CONTEXT} ); | ||||
1250 | $retval = $self->{HANDLER}->end_document( {} ); | ||||
1251 | }; | ||||
1252 | } | ||||
1253 | else { | ||||
1254 | eval { $retval = $self->_end_push( $self->{CONTEXT}, $restore ); }; | ||||
1255 | } | ||||
1256 | my $err = $@; | ||||
1257 | delete $self->{CONTEXT}; | ||||
1258 | if ( $err ) { | ||||
1259 | chomp $err unless ref $err; | ||||
1260 | croak( $err ); | ||||
1261 | } | ||||
1262 | return $retval; | ||||
1263 | } | ||||
1264 | |||||
1265 | 1; | ||||
1266 | |||||
1267 | #-------------------------------------------------------------------------# | ||||
1268 | # XML::LibXML::Node Interface # | ||||
1269 | #-------------------------------------------------------------------------# | ||||
1270 | package XML::LibXML::Node; | ||||
1271 | |||||
1272 | use Carp qw(croak); | ||||
1273 | |||||
1274 | use overload | ||||
1275 | '""' => sub { $_[0]->toString() }, | ||||
1276 | 'bool' => sub { 1 }, | ||||
1277 | '0+' => sub { Scalar::Util::refaddr($_[0]) }, | ||||
1278 | fallback => 1, | ||||
1279 | ; | ||||
1280 | |||||
1281 | |||||
1282 | sub CLONE_SKIP { | ||||
1283 | return $XML::LibXML::__threads_shared ? 0 : 1; | ||||
1284 | } | ||||
1285 | |||||
1286 | sub isSupported { | ||||
1287 | my $self = shift; | ||||
1288 | my $feature = shift; | ||||
1289 | return $self->can($feature) ? 1 : 0; | ||||
1290 | } | ||||
1291 | |||||
1292 | sub getChildNodes { my $self = shift; return $self->childNodes(); } | ||||
1293 | |||||
1294 | sub childNodes { | ||||
1295 | my $self = shift; | ||||
1296 | my @children = $self->_childNodes(0); | ||||
1297 | return wantarray ? @children : XML::LibXML::NodeList->new_from_ref(\@children , 1); | ||||
1298 | } | ||||
1299 | |||||
1300 | sub nonBlankChildNodes { | ||||
1301 | my $self = shift; | ||||
1302 | my @children = $self->_childNodes(1); | ||||
1303 | return wantarray ? @children : XML::LibXML::NodeList->new_from_ref(\@children , 1); | ||||
1304 | } | ||||
1305 | |||||
1306 | sub attributes { | ||||
1307 | my $self = shift; | ||||
1308 | my @attr = $self->_attributes(); | ||||
1309 | return wantarray ? @attr : XML::LibXML::NamedNodeMap->new( @attr ); | ||||
1310 | } | ||||
1311 | |||||
1312 | |||||
1313 | sub findnodes { | ||||
1314 | my ($node, $xpath) = @_; | ||||
1315 | my @nodes = $node->_findnodes($xpath); | ||||
1316 | if (wantarray) { | ||||
1317 | return @nodes; | ||||
1318 | } | ||||
1319 | else { | ||||
1320 | return XML::LibXML::NodeList->new_from_ref(\@nodes, 1); | ||||
1321 | } | ||||
1322 | } | ||||
1323 | |||||
1324 | sub exists { | ||||
1325 | my ($node, $xpath) = @_; | ||||
1326 | my (undef, $value) = $node->_find($xpath,1); | ||||
1327 | return $value; | ||||
1328 | } | ||||
1329 | |||||
1330 | sub findvalue { | ||||
1331 | my ($node, $xpath) = @_; | ||||
1332 | my $res; | ||||
1333 | $res = $node->find($xpath); | ||||
1334 | return $res->to_literal->value; | ||||
1335 | } | ||||
1336 | |||||
1337 | sub findbool { | ||||
1338 | my ($node, $xpath) = @_; | ||||
1339 | my ($type, @params) = $node->_find($xpath,1); | ||||
1340 | if ($type) { | ||||
1341 | return $type->new(@params); | ||||
1342 | } | ||||
1343 | return undef; | ||||
1344 | } | ||||
1345 | |||||
1346 | sub find { | ||||
1347 | my ($node, $xpath) = @_; | ||||
1348 | my ($type, @params) = $node->_find($xpath,0); | ||||
1349 | if ($type) { | ||||
1350 | return $type->new(@params); | ||||
1351 | } | ||||
1352 | return undef; | ||||
1353 | } | ||||
1354 | |||||
1355 | sub setOwnerDocument { | ||||
1356 | my ( $self, $doc ) = @_; | ||||
1357 | $doc->adoptNode( $self ); | ||||
1358 | } | ||||
1359 | |||||
1360 | sub toStringC14N { | ||||
1361 | my ($self, $comments, $xpath, $xpc) = @_; | ||||
1362 | return $self->_toStringC14N( $comments || 0, | ||||
1363 | (defined $xpath ? $xpath : undef), | ||||
1364 | 0, | ||||
1365 | undef, | ||||
1366 | (defined $xpc ? $xpc : undef) | ||||
1367 | ); | ||||
1368 | } | ||||
1369 | |||||
1370 | { | ||||
1371 | my $C14N_version_1_dot_1_val = 2; | ||||
1372 | |||||
1373 | sub toStringC14N_v1_1 { | ||||
1374 | my ($self, $comments, $xpath, $xpc) = @_; | ||||
1375 | |||||
1376 | return $self->_toStringC14N( | ||||
1377 | $comments || 0, | ||||
1378 | (defined $xpath ? $xpath : undef), | ||||
1379 | $C14N_version_1_dot_1_val, | ||||
1380 | undef, | ||||
1381 | (defined $xpc ? $xpc : undef) | ||||
1382 | ); | ||||
1383 | } | ||||
1384 | |||||
1385 | } | ||||
1386 | |||||
1387 | sub toStringEC14N { | ||||
1388 | my ($self, $comments, $xpath, $xpc, $inc_prefix_list) = @_; | ||||
1389 | unless (UNIVERSAL::isa($xpc,'XML::LibXML::XPathContext')) { | ||||
1390 | if ($inc_prefix_list) { | ||||
1391 | croak("toStringEC14N: 3rd argument is not an XML::LibXML::XPathContext"); | ||||
1392 | } else { | ||||
1393 | $inc_prefix_list=$xpc; | ||||
1394 | $xpc=undef; | ||||
1395 | } | ||||
1396 | } | ||||
1397 | if (defined($inc_prefix_list) and !UNIVERSAL::isa($inc_prefix_list,'ARRAY')) { | ||||
1398 | croak("toStringEC14N: inclusive_prefix_list must be undefined or ARRAY"); | ||||
1399 | } | ||||
1400 | return $self->_toStringC14N( $comments || 0, | ||||
1401 | (defined $xpath ? $xpath : undef), | ||||
1402 | 1, | ||||
1403 | (defined $inc_prefix_list ? $inc_prefix_list : undef), | ||||
1404 | (defined $xpc ? $xpc : undef) | ||||
1405 | ); | ||||
1406 | } | ||||
1407 | |||||
1408 | *serialize_c14n = \&toStringC14N; | ||||
1409 | *serialize_exc_c14n = \&toStringEC14N; | ||||
1410 | |||||
1411 | 1; | ||||
1412 | |||||
1413 | #-------------------------------------------------------------------------# | ||||
1414 | # XML::LibXML::Document Interface # | ||||
1415 | #-------------------------------------------------------------------------# | ||||
1416 | package XML::LibXML::Document; | ||||
1417 | |||||
1418 | use vars qw(@ISA); | ||||
1419 | @ISA = ('XML::LibXML::Node'); | ||||
1420 | |||||
1421 | sub actualEncoding { | ||||
1422 | my $doc = shift; | ||||
1423 | my $enc = $doc->encoding; | ||||
1424 | return (defined $enc and length $enc) ? $enc : 'UTF-8'; | ||||
1425 | } | ||||
1426 | |||||
1427 | sub setDocumentElement { | ||||
1428 | my $doc = shift; | ||||
1429 | my $element = shift; | ||||
1430 | |||||
1431 | my $oldelem = $doc->documentElement; | ||||
1432 | if ( defined $oldelem ) { | ||||
1433 | $doc->removeChild($oldelem); | ||||
1434 | } | ||||
1435 | |||||
1436 | $doc->_setDocumentElement($element); | ||||
1437 | } | ||||
1438 | |||||
1439 | sub toString { | ||||
1440 | my $self = shift; | ||||
1441 | my $flag = shift; | ||||
1442 | |||||
1443 | my $retval = ""; | ||||
1444 | |||||
1445 | if ( defined $XML::LibXML::skipXMLDeclaration | ||||
1446 | and $XML::LibXML::skipXMLDeclaration == 1 ) { | ||||
1447 | foreach ( $self->childNodes ){ | ||||
1448 | next if $_->nodeType == XML::LibXML::XML_DTD_NODE() | ||||
1449 | and $XML::LibXML::skipDTD; | ||||
1450 | $retval .= $_->toString; | ||||
1451 | } | ||||
1452 | } | ||||
1453 | else { | ||||
1454 | $flag ||= 0 unless defined $flag; | ||||
1455 | $retval = $self->_toString($flag); | ||||
1456 | } | ||||
1457 | |||||
1458 | return $retval; | ||||
1459 | } | ||||
1460 | |||||
1461 | sub serialize { | ||||
1462 | my $self = shift; | ||||
1463 | return $self->toString( @_ ); | ||||
1464 | } | ||||
1465 | |||||
1466 | #-------------------------------------------------------------------------# | ||||
1467 | # bad style xinclude processing # | ||||
1468 | #-------------------------------------------------------------------------# | ||||
1469 | sub process_xinclude { | ||||
1470 | my $self = shift; | ||||
1471 | my $opts = shift; | ||||
1472 | XML::LibXML->new->processXIncludes( $self, $opts ); | ||||
1473 | } | ||||
1474 | |||||
1475 | sub insertProcessingInstruction { | ||||
1476 | my $self = shift; | ||||
1477 | my $target = shift; | ||||
1478 | my $data = shift; | ||||
1479 | |||||
1480 | my $pi = $self->createPI( $target, $data ); | ||||
1481 | my $root = $self->documentElement; | ||||
1482 | |||||
1483 | if ( defined $root ) { | ||||
1484 | # this is actually not correct, but i guess it's what the user | ||||
1485 | # intends | ||||
1486 | $self->insertBefore( $pi, $root ); | ||||
1487 | } | ||||
1488 | else { | ||||
1489 | # if no documentElement was found we just append the PI | ||||
1490 | $self->appendChild( $pi ); | ||||
1491 | } | ||||
1492 | } | ||||
1493 | |||||
1494 | sub insertPI { | ||||
1495 | my $self = shift; | ||||
1496 | $self->insertProcessingInstruction( @_ ); | ||||
1497 | } | ||||
1498 | |||||
1499 | #-------------------------------------------------------------------------# | ||||
1500 | # DOM L3 Document functions. | ||||
1501 | # added after robins implicit feature request | ||||
1502 | #-------------------------------------------------------------------------# | ||||
1503 | *getElementsByTagName = \&XML::LibXML::Element::getElementsByTagName; | ||||
1504 | *getElementsByTagNameNS = \&XML::LibXML::Element::getElementsByTagNameNS; | ||||
1505 | *getElementsByLocalName = \&XML::LibXML::Element::getElementsByLocalName; | ||||
1506 | |||||
1507 | 1; | ||||
1508 | |||||
1509 | #-------------------------------------------------------------------------# | ||||
1510 | # XML::LibXML::DocumentFragment Interface # | ||||
1511 | #-------------------------------------------------------------------------# | ||||
1512 | package XML::LibXML::DocumentFragment; | ||||
1513 | |||||
1514 | use vars qw(@ISA); | ||||
1515 | @ISA = ('XML::LibXML::Node'); | ||||
1516 | |||||
1517 | sub toString { | ||||
1518 | my $self = shift; | ||||
1519 | my $retval = ""; | ||||
1520 | if ( $self->hasChildNodes() ) { | ||||
1521 | foreach my $n ( $self->childNodes() ) { | ||||
1522 | $retval .= $n->toString(@_); | ||||
1523 | } | ||||
1524 | } | ||||
1525 | return $retval; | ||||
1526 | } | ||||
1527 | |||||
1528 | *serialize = \&toString; | ||||
1529 | |||||
1530 | 1; | ||||
1531 | |||||
1532 | #-------------------------------------------------------------------------# | ||||
1533 | # XML::LibXML::Element Interface # | ||||
1534 | #-------------------------------------------------------------------------# | ||||
1535 | package XML::LibXML::Element; | ||||
1536 | |||||
1537 | use vars qw(@ISA); | ||||
1538 | @ISA = ('XML::LibXML::Node'); | ||||
1539 | use XML::LibXML qw(:ns :libxml); | ||||
1540 | use XML::LibXML::AttributeHash; | ||||
1541 | use Carp; | ||||
1542 | |||||
1543 | use Scalar::Util qw(blessed); | ||||
1544 | |||||
1545 | use overload | ||||
1546 | '%{}' => 'getAttributeHash', | ||||
1547 | 'eq' => '_isSameNodeLax', '==' => '_isSameNodeLax', | ||||
1548 | 'ne' => '_isNotSameNodeLax', '!=' => '_isNotSameNodeLax', | ||||
1549 | fallback => 1, | ||||
1550 | ; | ||||
1551 | |||||
1552 | sub _isNotSameNodeLax { | ||||
1553 | my ($self, $other) = @_; | ||||
1554 | |||||
1555 | return ((not $self->_isSameNodeLax($other)) ? 1 : ''); | ||||
1556 | } | ||||
1557 | |||||
1558 | sub _isSameNodeLax { | ||||
1559 | my ($self, $other) = @_; | ||||
1560 | |||||
1561 | if (blessed($other) and $other->isa('XML::LibXML::Element')) | ||||
1562 | { | ||||
1563 | return ($self->isSameNode($other) ? 1 : ''); | ||||
1564 | } | ||||
1565 | else | ||||
1566 | { | ||||
1567 | return ''; | ||||
1568 | } | ||||
1569 | } | ||||
1570 | |||||
1571 | { | ||||
1572 | my %tiecache; | ||||
1573 | |||||
1574 | sub __destroy_tiecache | ||||
1575 | { | ||||
1576 | delete $tiecache{ 0+$_[0] }; | ||||
1577 | } | ||||
1578 | |||||
1579 | sub getAttributeHash | ||||
1580 | { | ||||
1581 | my $self = shift; | ||||
1582 | if (!exists $tiecache{ 0+$self }) { | ||||
1583 | tie my %attr, 'XML::LibXML::AttributeHash', $self, weaken => 1; | ||||
1584 | $tiecache{ 0+$self } = \%attr; | ||||
1585 | } | ||||
1586 | return $tiecache{ 0+$self }; | ||||
1587 | } | ||||
1588 | sub DESTROY | ||||
1589 | { | ||||
1590 | my ($self) = @_; | ||||
1591 | $self->__destroy_tiecache; | ||||
1592 | $self->SUPER::DESTROY; | ||||
1593 | } | ||||
1594 | } | ||||
1595 | |||||
1596 | sub setNamespace { | ||||
1597 | my $self = shift; | ||||
1598 | my $n = $self->localname; | ||||
1599 | if ( $self->_setNamespace(@_) ){ | ||||
1600 | if ( scalar @_ < 3 || $_[2] == 1 ){ | ||||
1601 | $self->setNodeName( $n ); | ||||
1602 | } | ||||
1603 | return 1; | ||||
1604 | } | ||||
1605 | return 0; | ||||
1606 | } | ||||
1607 | |||||
1608 | sub getAttribute { | ||||
1609 | my $self = shift; | ||||
1610 | my $name = $_[0]; | ||||
1611 | if ( $name =~ /^xmlns(?::|$)/ ) { | ||||
1612 | # user wants to get a namespace ... | ||||
1613 | (my $prefix = $name )=~s/^xmlns:?//; | ||||
1614 | $self->_getNamespaceDeclURI($prefix); | ||||
1615 | } | ||||
1616 | else { | ||||
1617 | $self->_getAttribute(@_); | ||||
1618 | } | ||||
1619 | } | ||||
1620 | |||||
1621 | sub setAttribute { | ||||
1622 | my ( $self, $name, $value ) = @_; | ||||
1623 | if ( $name =~ /^xmlns(?::|$)/ ) { | ||||
1624 | # user wants to set the special attribute for declaring XML namespace ... | ||||
1625 | |||||
1626 | # this is fine but not exactly DOM conformant behavior, btw (according to DOM we should | ||||
1627 | # probably declare an attribute which looks like XML namespace declaration | ||||
1628 | # but isn't) | ||||
1629 | (my $nsprefix = $name )=~s/^xmlns:?//; | ||||
1630 | my $nn = $self->nodeName; | ||||
1631 | if ( $nn =~ /^\Q${nsprefix}\E:/ ) { | ||||
1632 | # the element has the same prefix | ||||
1633 | $self->setNamespaceDeclURI($nsprefix,$value) || | ||||
1634 | $self->setNamespace($value,$nsprefix,1); | ||||
1635 | ## | ||||
1636 | ## We set the namespace here. | ||||
1637 | ## This is helpful, as in: | ||||
1638 | ## | ||||
1639 | ## | $e = XML::LibXML::Element->new('foo:bar'); | ||||
1640 | ## | $e->setAttribute('xmlns:foo','http://yoyodine') | ||||
1641 | ## | ||||
1642 | } | ||||
1643 | else { | ||||
1644 | # just modify the namespace | ||||
1645 | $self->setNamespaceDeclURI($nsprefix, $value) || | ||||
1646 | $self->setNamespace($value,$nsprefix,0); | ||||
1647 | } | ||||
1648 | } | ||||
1649 | else { | ||||
1650 | $self->_setAttribute($name, $value); | ||||
1651 | } | ||||
1652 | } | ||||
1653 | |||||
1654 | sub getAttributeNS { | ||||
1655 | my $self = shift; | ||||
1656 | my ($nsURI, $name) = @_; | ||||
1657 | croak("invalid attribute name") if !defined($name) or $name eq q{}; | ||||
1658 | if ( defined($nsURI) and $nsURI eq XML_XMLNS_NS ) { | ||||
1659 | $self->_getNamespaceDeclURI($name eq 'xmlns' ? undef : $name); | ||||
1660 | } | ||||
1661 | else { | ||||
1662 | $self->_getAttributeNS(@_); | ||||
1663 | } | ||||
1664 | } | ||||
1665 | |||||
1666 | sub setAttributeNS { | ||||
1667 | my ($self, $nsURI, $qname, $value)=@_; | ||||
1668 | unless (defined $qname and length $qname) { | ||||
1669 | croak("bad name"); | ||||
1670 | } | ||||
1671 | if (defined($nsURI) and $nsURI eq XML_XMLNS_NS) { | ||||
1672 | if ($qname !~ /^xmlns(?::|$)/) { | ||||
1673 | croak("NAMESPACE ERROR: Namespace declarations must have the prefix 'xmlns'"); | ||||
1674 | } | ||||
1675 | $self->setAttribute($qname,$value); # see implementation above | ||||
1676 | return; | ||||
1677 | } | ||||
1678 | if ($qname=~/:/ and not (defined($nsURI) and length($nsURI))) { | ||||
1679 | croak("NAMESPACE ERROR: Attribute without a prefix cannot be in a namespace"); | ||||
1680 | } | ||||
1681 | if ($qname=~/^xmlns(?:$|:)/) { | ||||
1682 | croak("NAMESPACE ERROR: 'xmlns' prefix and qualified-name are reserved for the namespace ".XML_XMLNS_NS); | ||||
1683 | } | ||||
1684 | if ($qname=~/^xml:/ and not (defined $nsURI and $nsURI eq XML_XML_NS)) { | ||||
1685 | croak("NAMESPACE ERROR: 'xml' prefix is reserved for the namespace ".XML_XML_NS); | ||||
1686 | } | ||||
1687 | $self->_setAttributeNS( defined $nsURI ? $nsURI : undef, $qname, $value ); | ||||
1688 | } | ||||
1689 | |||||
1690 | sub getElementsByTagName { | ||||
1691 | my ( $node , $name ) = @_; | ||||
1692 | my $xpath = $name eq '*' ? "descendant::*" : "descendant::*[name()='$name']"; | ||||
1693 | my @nodes = $node->_findnodes($xpath); | ||||
1694 | return wantarray ? @nodes : XML::LibXML::NodeList->new_from_ref(\@nodes, 1); | ||||
1695 | } | ||||
1696 | |||||
1697 | sub getElementsByTagNameNS { | ||||
1698 | my ( $node, $nsURI, $name ) = @_; | ||||
1699 | my $xpath; | ||||
1700 | if ( $name eq '*' ) { | ||||
1701 | if ( $nsURI eq '*' ) { | ||||
1702 | $xpath = "descendant::*"; | ||||
1703 | } else { | ||||
1704 | $xpath = "descendant::*[namespace-uri()='$nsURI']"; | ||||
1705 | } | ||||
1706 | } elsif ( $nsURI eq '*' ) { | ||||
1707 | $xpath = "descendant::*[local-name()='$name']"; | ||||
1708 | } else { | ||||
1709 | $xpath = "descendant::*[local-name()='$name' and namespace-uri()='$nsURI']"; | ||||
1710 | } | ||||
1711 | my @nodes = $node->_findnodes($xpath); | ||||
1712 | return wantarray ? @nodes : XML::LibXML::NodeList->new_from_ref(\@nodes, 1); | ||||
1713 | } | ||||
1714 | |||||
1715 | sub getElementsByLocalName { | ||||
1716 | my ( $node,$name ) = @_; | ||||
1717 | my $xpath; | ||||
1718 | if ($name eq '*') { | ||||
1719 | $xpath = "descendant::*"; | ||||
1720 | } else { | ||||
1721 | $xpath = "descendant::*[local-name()='$name']"; | ||||
1722 | } | ||||
1723 | my @nodes = $node->_findnodes($xpath); | ||||
1724 | return wantarray ? @nodes : XML::LibXML::NodeList->new_from_ref(\@nodes, 1); | ||||
1725 | } | ||||
1726 | |||||
1727 | sub getChildrenByTagName { | ||||
1728 | my ( $node, $name ) = @_; | ||||
1729 | my @nodes; | ||||
1730 | if ($name eq '*') { | ||||
1731 | @nodes = grep { $_->nodeType == XML_ELEMENT_NODE() } | ||||
1732 | $node->childNodes(); | ||||
1733 | } else { | ||||
1734 | @nodes = grep { $_->nodeName eq $name } $node->childNodes(); | ||||
1735 | } | ||||
1736 | return wantarray ? @nodes : XML::LibXML::NodeList->new_from_ref(\@nodes, 1); | ||||
1737 | } | ||||
1738 | |||||
1739 | sub getChildrenByLocalName { | ||||
1740 | my ( $node, $name ) = @_; | ||||
1741 | # my @nodes; | ||||
1742 | # if ($name eq '*') { | ||||
1743 | # @nodes = grep { $_->nodeType == XML_ELEMENT_NODE() } | ||||
1744 | # $node->childNodes(); | ||||
1745 | # } else { | ||||
1746 | # @nodes = grep { $_->nodeType == XML_ELEMENT_NODE() and | ||||
1747 | # $_->localName eq $name } $node->childNodes(); | ||||
1748 | # } | ||||
1749 | # return wantarray ? @nodes : XML::LibXML::NodeList->new_from_ref(\@nodes, 1); | ||||
1750 | my @nodes = $node->_getChildrenByTagNameNS('*',$name); | ||||
1751 | return wantarray ? @nodes : XML::LibXML::NodeList->new_from_ref(\@nodes, 1); | ||||
1752 | } | ||||
1753 | |||||
1754 | sub getChildrenByTagNameNS { | ||||
1755 | my ( $node, $nsURI, $name ) = @_; | ||||
1756 | my @nodes = $node->_getChildrenByTagNameNS($nsURI,$name); | ||||
1757 | return wantarray ? @nodes : XML::LibXML::NodeList->new_from_ref(\@nodes, 1); | ||||
1758 | } | ||||
1759 | |||||
1760 | sub appendWellBalancedChunk { | ||||
1761 | my ( $self, $chunk ) = @_; | ||||
1762 | |||||
1763 | my $local_parser = XML::LibXML->new(); | ||||
1764 | my $frag = $local_parser->parse_xml_chunk( $chunk ); | ||||
1765 | |||||
1766 | $self->appendChild( $frag ); | ||||
1767 | } | ||||
1768 | |||||
1769 | 1; | ||||
1770 | |||||
1771 | #-------------------------------------------------------------------------# | ||||
1772 | # XML::LibXML::Text Interface # | ||||
1773 | #-------------------------------------------------------------------------# | ||||
1774 | package XML::LibXML::Text; | ||||
1775 | |||||
1776 | use vars qw(@ISA); | ||||
1777 | @ISA = ('XML::LibXML::Node'); | ||||
1778 | |||||
1779 | sub attributes { return; } | ||||
1780 | |||||
1781 | sub deleteDataString { | ||||
1782 | my ($node, $string, $all) = @_; | ||||
1783 | |||||
1784 | return $node->replaceDataString($string, '', $all); | ||||
1785 | } | ||||
1786 | |||||
1787 | sub replaceDataString { | ||||
1788 | my ( $node, $left_proto, $right,$all ) = @_; | ||||
1789 | |||||
1790 | # Assure we exchange the strings and not expressions! | ||||
1791 | my $left = quotemeta($left_proto); | ||||
1792 | |||||
1793 | my $datastr = $node->nodeValue(); | ||||
1794 | if ( $all ) { | ||||
1795 | $datastr =~ s/$left/$right/g; | ||||
1796 | } | ||||
1797 | else{ | ||||
1798 | $datastr =~ s/$left/$right/; | ||||
1799 | } | ||||
1800 | $node->setData( $datastr ); | ||||
1801 | } | ||||
1802 | |||||
1803 | sub replaceDataRegEx { | ||||
1804 | my ( $node, $leftre, $rightre, $flags ) = @_; | ||||
1805 | return unless defined $leftre; | ||||
1806 | $rightre ||= ""; | ||||
1807 | |||||
1808 | my $datastr = $node->nodeValue(); | ||||
1809 | my $restr = "s/" . $leftre . "/" . $rightre . "/"; | ||||
1810 | $restr .= $flags if defined $flags; | ||||
1811 | |||||
1812 | eval '$datastr =~ '. $restr; | ||||
1813 | |||||
1814 | $node->setData( $datastr ); | ||||
1815 | } | ||||
1816 | |||||
1817 | 1; | ||||
1818 | |||||
1819 | package XML::LibXML::Comment; | ||||
1820 | |||||
1821 | use vars qw(@ISA); | ||||
1822 | @ISA = ('XML::LibXML::Text'); | ||||
1823 | |||||
1824 | 1; | ||||
1825 | |||||
1826 | package XML::LibXML::CDATASection; | ||||
1827 | |||||
1828 | use vars qw(@ISA); | ||||
1829 | @ISA = ('XML::LibXML::Text'); | ||||
1830 | |||||
1831 | 1; | ||||
1832 | |||||
1833 | #-------------------------------------------------------------------------# | ||||
1834 | # XML::LibXML::Attribute Interface # | ||||
1835 | #-------------------------------------------------------------------------# | ||||
1836 | package XML::LibXML::Attr; | ||||
1837 | use vars qw( @ISA ) ; | ||||
1838 | @ISA = ('XML::LibXML::Node') ; | ||||
1839 | |||||
1840 | sub setNamespace { | ||||
1841 | my ($self,$href,$prefix) = @_; | ||||
1842 | my $n = $self->localname; | ||||
1843 | if ( $self->_setNamespace($href,$prefix) ) { | ||||
1844 | $self->setNodeName($n); | ||||
1845 | return 1; | ||||
1846 | } | ||||
1847 | |||||
1848 | return 0; | ||||
1849 | } | ||||
1850 | |||||
1851 | 1; | ||||
1852 | |||||
1853 | #-------------------------------------------------------------------------# | ||||
1854 | # XML::LibXML::Dtd Interface # | ||||
1855 | #-------------------------------------------------------------------------# | ||||
1856 | # this is still under construction | ||||
1857 | # | ||||
1858 | package XML::LibXML::Dtd; | ||||
1859 | use vars qw( @ISA ); | ||||
1860 | @ISA = ('XML::LibXML::Node'); | ||||
1861 | |||||
1862 | # at least DESTROY and CLONE_SKIP must be inherited | ||||
1863 | |||||
1864 | 1; | ||||
1865 | |||||
1866 | #-------------------------------------------------------------------------# | ||||
1867 | # XML::LibXML::PI Interface # | ||||
1868 | #-------------------------------------------------------------------------# | ||||
1869 | package XML::LibXML::PI; | ||||
1870 | use vars qw( @ISA ); | ||||
1871 | @ISA = ('XML::LibXML::Node'); | ||||
1872 | |||||
1873 | sub setData { | ||||
1874 | my $pi = shift; | ||||
1875 | |||||
1876 | my $string = ""; | ||||
1877 | if ( scalar @_ == 1 ) { | ||||
1878 | $string = shift; | ||||
1879 | } | ||||
1880 | else { | ||||
1881 | my %h = @_; | ||||
1882 | $string = join " ", map {$_.'="'.$h{$_}.'"'} keys %h; | ||||
1883 | } | ||||
1884 | |||||
1885 | # the spec says any char but "?>" [17] | ||||
1886 | $pi->_setData( $string ) unless $string =~ /\?>/; | ||||
1887 | } | ||||
1888 | |||||
1889 | 1; | ||||
1890 | |||||
1891 | #-------------------------------------------------------------------------# | ||||
1892 | # XML::LibXML::Namespace Interface # | ||||
1893 | #-------------------------------------------------------------------------# | ||||
1894 | package XML::LibXML::Namespace; | ||||
1895 | |||||
1896 | sub CLONE_SKIP { 1 } | ||||
1897 | |||||
1898 | # In fact, this is not a node! | ||||
1899 | sub prefix { return "xmlns"; } | ||||
1900 | sub getPrefix { return "xmlns"; } | ||||
1901 | sub getNamespaceURI { return "http://www.w3.org/2000/xmlns/" }; | ||||
1902 | |||||
1903 | sub getNamespaces { return (); } | ||||
1904 | |||||
1905 | sub nodeName { | ||||
1906 | my $self = shift; | ||||
1907 | my $nsP = $self->localname; | ||||
1908 | return ( defined($nsP) && length($nsP) ) ? "xmlns:$nsP" : "xmlns"; | ||||
1909 | } | ||||
1910 | sub name { goto &nodeName } | ||||
1911 | sub getName { goto &nodeName } | ||||
1912 | |||||
1913 | sub isEqualNode { | ||||
1914 | my ( $self, $ref ) = @_; | ||||
1915 | if ( ref($ref) eq "XML::LibXML::Namespace" ) { | ||||
1916 | return $self->_isEqual($ref); | ||||
1917 | } | ||||
1918 | return 0; | ||||
1919 | } | ||||
1920 | |||||
1921 | sub isSameNode { | ||||
1922 | my ( $self, $ref ) = @_; | ||||
1923 | if ( $$self == $$ref ){ | ||||
1924 | return 1; | ||||
1925 | } | ||||
1926 | return 0; | ||||
1927 | } | ||||
1928 | |||||
1929 | 1; | ||||
1930 | |||||
1931 | #-------------------------------------------------------------------------# | ||||
1932 | # XML::LibXML::NamedNodeMap Interface # | ||||
1933 | #-------------------------------------------------------------------------# | ||||
1934 | package XML::LibXML::NamedNodeMap; | ||||
1935 | |||||
1936 | use XML::LibXML qw(:libxml); | ||||
1937 | |||||
1938 | sub CLONE_SKIP { | ||||
1939 | return $XML::LibXML::__threads_shared ? 0 : 1; | ||||
1940 | } | ||||
1941 | |||||
1942 | sub new { | ||||
1943 | my $class = shift; | ||||
1944 | my $self = bless { Nodes => [@_] }, $class; | ||||
1945 | $self->{NodeMap} = { map { $_->nodeName => $_ } @_ }; | ||||
1946 | return $self; | ||||
1947 | } | ||||
1948 | |||||
1949 | sub length { return scalar( @{$_[0]->{Nodes}} ); } | ||||
1950 | sub nodes { return $_[0]->{Nodes}; } | ||||
1951 | sub item { $_[0]->{Nodes}->[$_[1]]; } | ||||
1952 | |||||
1953 | sub getNamedItem { | ||||
1954 | my $self = shift; | ||||
1955 | my $name = shift; | ||||
1956 | |||||
1957 | return $self->{NodeMap}->{$name}; | ||||
1958 | } | ||||
1959 | |||||
1960 | sub setNamedItem { | ||||
1961 | my $self = shift; | ||||
1962 | my $node = shift; | ||||
1963 | |||||
1964 | my $retval; | ||||
1965 | if ( defined $node ) { | ||||
1966 | if ( scalar @{$self->{Nodes}} ) { | ||||
1967 | my $name = $node->nodeName(); | ||||
1968 | if ( $node->nodeType() == XML_NAMESPACE_DECL ) { | ||||
1969 | return; | ||||
1970 | } | ||||
1971 | if ( defined $self->{NodeMap}->{$name} ) { | ||||
1972 | if ( $node->isSameNode( $self->{NodeMap}->{$name} ) ) { | ||||
1973 | return; | ||||
1974 | } | ||||
1975 | $retval = $self->{NodeMap}->{$name}->replaceNode( $node ); | ||||
1976 | } | ||||
1977 | else { | ||||
1978 | $self->{Nodes}->[0]->addSibling($node); | ||||
1979 | } | ||||
1980 | |||||
1981 | $self->{NodeMap}->{$name} = $node; | ||||
1982 | push @{$self->{Nodes}}, $node; | ||||
1983 | } | ||||
1984 | else { | ||||
1985 | # not done yet | ||||
1986 | # can this be properly be done??? | ||||
1987 | warn "not done yet\n"; | ||||
1988 | } | ||||
1989 | } | ||||
1990 | return $retval; | ||||
1991 | } | ||||
1992 | |||||
1993 | sub removeNamedItem { | ||||
1994 | my $self = shift; | ||||
1995 | my $name = shift; | ||||
1996 | my $retval; | ||||
1997 | if ( $name =~ /^xmlns/ ) { | ||||
1998 | warn "not done yet\n"; | ||||
1999 | } | ||||
2000 | elsif ( exists $self->{NodeMap}->{$name} ) { | ||||
2001 | $retval = $self->{NodeMap}->{$name}; | ||||
2002 | $retval->unbindNode; | ||||
2003 | delete $self->{NodeMap}->{$name}; | ||||
2004 | $self->{Nodes} = [grep {not($retval->isSameNode($_))} @{$self->{Nodes}}]; | ||||
2005 | } | ||||
2006 | |||||
2007 | return $retval; | ||||
2008 | } | ||||
2009 | |||||
2010 | sub getNamedItemNS { | ||||
2011 | my $self = shift; | ||||
2012 | my $nsURI = shift; | ||||
2013 | my $name = shift; | ||||
2014 | return undef; | ||||
2015 | } | ||||
2016 | |||||
2017 | sub setNamedItemNS { | ||||
2018 | my $self = shift; | ||||
2019 | my $nsURI = shift; | ||||
2020 | my $node = shift; | ||||
2021 | return undef; | ||||
2022 | } | ||||
2023 | |||||
2024 | sub removeNamedItemNS { | ||||
2025 | my $self = shift; | ||||
2026 | my $nsURI = shift; | ||||
2027 | my $name = shift; | ||||
2028 | return undef; | ||||
2029 | } | ||||
2030 | |||||
2031 | 1; | ||||
2032 | |||||
2033 | package XML::LibXML::_SAXParser; | ||||
2034 | |||||
2035 | # this is pseudo class!!! and it will be removed as soon all functions | ||||
2036 | # moved to XS level | ||||
2037 | |||||
2038 | use XML::SAX::Exception; | ||||
2039 | |||||
2040 | sub CLONE_SKIP { | ||||
2041 | return $XML::LibXML::__threads_shared ? 0 : 1; | ||||
2042 | } | ||||
2043 | |||||
2044 | # these functions will use SAX exceptions as soon i know how things really work | ||||
2045 | sub warning { | ||||
2046 | my ( $parser, $message, $line, $col ) = @_; | ||||
2047 | my $error = XML::SAX::Exception::Parse->new( LineNumber => $line, | ||||
2048 | ColumnNumber => $col, | ||||
2049 | Message => $message, ); | ||||
2050 | $parser->{HANDLER}->warning( $error ); | ||||
2051 | } | ||||
2052 | |||||
2053 | sub error { | ||||
2054 | my ( $parser, $message, $line, $col ) = @_; | ||||
2055 | |||||
2056 | my $error = XML::SAX::Exception::Parse->new( LineNumber => $line, | ||||
2057 | ColumnNumber => $col, | ||||
2058 | Message => $message, ); | ||||
2059 | $parser->{HANDLER}->error( $error ); | ||||
2060 | } | ||||
2061 | |||||
2062 | sub fatal_error { | ||||
2063 | my ( $parser, $message, $line, $col ) = @_; | ||||
2064 | my $error = XML::SAX::Exception::Parse->new( LineNumber => $line, | ||||
2065 | ColumnNumber => $col, | ||||
2066 | Message => $message, ); | ||||
2067 | $parser->{HANDLER}->fatal_error( $error ); | ||||
2068 | } | ||||
2069 | |||||
2070 | 1; | ||||
2071 | |||||
2072 | package XML::LibXML::RelaxNG; | ||||
2073 | |||||
2074 | sub CLONE_SKIP { 1 } | ||||
2075 | |||||
2076 | sub new { | ||||
2077 | my $class = shift; | ||||
2078 | my %args = @_; | ||||
2079 | |||||
2080 | my $self = undef; | ||||
2081 | if ( defined $args{location} ) { | ||||
2082 | $self = $class->parse_location( $args{location}, XML::LibXML->_parser_options(\%args), $args{recover} ); | ||||
2083 | } | ||||
2084 | elsif ( defined $args{string} ) { | ||||
2085 | $self = $class->parse_buffer( $args{string}, XML::LibXML->_parser_options(\%args), $args{recover} ); | ||||
2086 | } | ||||
2087 | elsif ( defined $args{DOM} ) { | ||||
2088 | $self = $class->parse_document( $args{DOM}, XML::LibXML->_parser_options(\%args), $args{recover} ); | ||||
2089 | } | ||||
2090 | |||||
2091 | return $self; | ||||
2092 | } | ||||
2093 | |||||
2094 | 1; | ||||
2095 | |||||
2096 | package XML::LibXML::Schema; | ||||
2097 | |||||
2098 | sub CLONE_SKIP { 1 } | ||||
2099 | |||||
2100 | sub new { | ||||
2101 | my $class = shift; | ||||
2102 | my %args = @_; | ||||
2103 | |||||
2104 | my $self = undef; | ||||
2105 | if ( defined $args{location} ) { | ||||
2106 | $self = $class->parse_location( $args{location}, XML::LibXML->_parser_options(\%args), $args{recover} ); | ||||
2107 | } | ||||
2108 | elsif ( defined $args{string} ) { | ||||
2109 | $self = $class->parse_buffer( $args{string}, XML::LibXML->_parser_options(\%args), $args{recover} ); | ||||
2110 | } | ||||
2111 | |||||
2112 | return $self; | ||||
2113 | } | ||||
2114 | |||||
2115 | 1; | ||||
2116 | |||||
2117 | #-------------------------------------------------------------------------# | ||||
2118 | # XML::LibXML::Pattern Interface # | ||||
2119 | #-------------------------------------------------------------------------# | ||||
2120 | |||||
2121 | package XML::LibXML::Pattern; | ||||
2122 | |||||
2123 | sub CLONE_SKIP { 1 } | ||||
2124 | |||||
2125 | sub new { | ||||
2126 | my $class = shift; | ||||
2127 | my ($pattern,$ns_map)=@_; | ||||
2128 | my $self = undef; | ||||
2129 | |||||
2130 | unless (UNIVERSAL::can($class,'_compilePattern')) { | ||||
2131 | croak("Cannot create XML::LibXML::Pattern - ". | ||||
2132 | "your libxml2 is compiled without pattern support!"); | ||||
2133 | } | ||||
2134 | |||||
2135 | if (ref($ns_map) eq 'HASH') { | ||||
2136 | # translate prefix=>URL hash to a (URL,prefix) list | ||||
2137 | $self = $class->_compilePattern($pattern,0,[reverse %$ns_map]); | ||||
2138 | } else { | ||||
2139 | $self = $class->_compilePattern($pattern,0); | ||||
2140 | } | ||||
2141 | return $self; | ||||
2142 | } | ||||
2143 | |||||
2144 | 1; | ||||
2145 | |||||
2146 | #-------------------------------------------------------------------------# | ||||
2147 | # XML::LibXML::RegExp Interface # | ||||
2148 | #-------------------------------------------------------------------------# | ||||
2149 | |||||
2150 | package XML::LibXML::RegExp; | ||||
2151 | |||||
2152 | sub CLONE_SKIP { 1 } | ||||
2153 | |||||
2154 | sub new { | ||||
2155 | my $class = shift; | ||||
2156 | my ($regexp)=@_; | ||||
2157 | unless (UNIVERSAL::can($class,'_compile')) { | ||||
2158 | croak("Cannot create XML::LibXML::RegExp - ". | ||||
2159 | "your libxml2 is compiled without regexp support!"); | ||||
2160 | } | ||||
2161 | return $class->_compile($regexp); | ||||
2162 | } | ||||
2163 | |||||
2164 | 1; | ||||
2165 | |||||
2166 | #-------------------------------------------------------------------------# | ||||
2167 | # XML::LibXML::XPathExpression Interface # | ||||
2168 | #-------------------------------------------------------------------------# | ||||
2169 | |||||
2170 | package XML::LibXML::XPathExpression; | ||||
2171 | |||||
2172 | sub CLONE_SKIP { 1 } | ||||
2173 | |||||
2174 | 1; | ||||
2175 | |||||
2176 | |||||
2177 | #-------------------------------------------------------------------------# | ||||
2178 | # XML::LibXML::InputCallback Interface # | ||||
2179 | #-------------------------------------------------------------------------# | ||||
2180 | package XML::LibXML::InputCallback; | ||||
2181 | |||||
2182 | use vars qw($_CUR_CB @_GLOBAL_CALLBACKS @_CB_STACK $_CB_NESTED_DEPTH @_CB_NESTED_STACK); | ||||
2183 | |||||
2184 | BEGIN { | ||||
2185 | $_CUR_CB = undef; | ||||
2186 | @_GLOBAL_CALLBACKS = (); | ||||
2187 | @_CB_STACK = (); | ||||
2188 | $_CB_NESTED_DEPTH = 0; | ||||
2189 | @_CB_NESTED_STACK = (); | ||||
2190 | } | ||||
2191 | |||||
2192 | sub CLONE_SKIP { | ||||
2193 | return $XML::LibXML::__threads_shared ? 0 : 1; | ||||
2194 | } | ||||
2195 | |||||
2196 | #-------------------------------------------------------------------------# | ||||
2197 | # global callbacks # | ||||
2198 | #-------------------------------------------------------------------------# | ||||
2199 | sub _callback_match { | ||||
2200 | my $uri = shift; | ||||
2201 | my $retval = 0; | ||||
2202 | |||||
2203 | # loop through the callbacks, and find the first matching one. | ||||
2204 | # The callbacks are stored in execution order (reverse stack order). | ||||
2205 | # Any new global callbacks are shifted to the callback stack. | ||||
2206 | foreach my $cb ( @_GLOBAL_CALLBACKS ) { | ||||
2207 | |||||
2208 | # callbacks have to return 1, 0 or undef, while 0 and undef | ||||
2209 | # are handled the same way. | ||||
2210 | # in fact, if callbacks return other values, the global match | ||||
2211 | # assumes silently that the callback failed. | ||||
2212 | |||||
2213 | $retval = $cb->[0]->($uri); | ||||
2214 | |||||
2215 | if ( defined $retval and $retval == 1 ) { | ||||
2216 | # make the other callbacks use this callback | ||||
2217 | $_CUR_CB = $cb; | ||||
2218 | unshift @_CB_STACK, $cb; | ||||
2219 | last; | ||||
2220 | } | ||||
2221 | } | ||||
2222 | |||||
2223 | return $retval; | ||||
2224 | } | ||||
2225 | |||||
2226 | sub _callback_open { | ||||
2227 | my $uri = shift; | ||||
2228 | my $retval = undef; | ||||
2229 | |||||
2230 | # the open callback has to return a defined value. | ||||
2231 | # if one works on files this can be a file handle. But | ||||
2232 | # depending on the needs of the callback it also can be a | ||||
2233 | # database handle or a integer labeling a certain dataset. | ||||
2234 | |||||
2235 | if ( defined $_CUR_CB ) { | ||||
2236 | $retval = $_CUR_CB->[1]->( $uri ); | ||||
2237 | |||||
2238 | # reset the callbacks, if one callback cannot open an uri | ||||
2239 | if ( not defined $retval or $retval == 0 ) { | ||||
2240 | shift @_CB_STACK; | ||||
2241 | $_CUR_CB = $_CB_STACK[0]; | ||||
2242 | } | ||||
2243 | } | ||||
2244 | |||||
2245 | return $retval; | ||||
2246 | } | ||||
2247 | |||||
2248 | sub _callback_read { | ||||
2249 | my $fh = shift; | ||||
2250 | my $buflen = shift; | ||||
2251 | |||||
2252 | my $retval = undef; | ||||
2253 | |||||
2254 | if ( defined $_CUR_CB ) { | ||||
2255 | $retval = $_CUR_CB->[2]->( $fh, $buflen ); | ||||
2256 | } | ||||
2257 | |||||
2258 | return $retval; | ||||
2259 | } | ||||
2260 | |||||
2261 | sub _callback_close { | ||||
2262 | my $fh = shift; | ||||
2263 | my $retval = 0; | ||||
2264 | |||||
2265 | if ( defined $_CUR_CB ) { | ||||
2266 | $retval = $_CUR_CB->[3]->( $fh ); | ||||
2267 | shift @_CB_STACK; | ||||
2268 | $_CUR_CB = $_CB_STACK[0]; | ||||
2269 | } | ||||
2270 | |||||
2271 | return $retval; | ||||
2272 | } | ||||
2273 | |||||
2274 | #-------------------------------------------------------------------------# | ||||
2275 | # member functions and methods # | ||||
2276 | #-------------------------------------------------------------------------# | ||||
2277 | |||||
2278 | sub new { | ||||
2279 | my $CLASS = shift; | ||||
2280 | return bless {'_CALLBACKS' => []}, $CLASS; | ||||
2281 | } | ||||
2282 | |||||
2283 | # add a callback set to the callback stack | ||||
2284 | # synopsis: $icb->register_callbacks( [$match_cb, $open_cb, $read_cb, $close_cb] ); | ||||
2285 | sub register_callbacks { | ||||
2286 | my $self = shift; | ||||
2287 | my $cbset = shift; | ||||
2288 | |||||
2289 | # test if callback set is complete | ||||
2290 | if ( ref $cbset eq "ARRAY" and scalar( @$cbset ) == 4 ) { | ||||
2291 | unshift @{$self->{_CALLBACKS}}, $cbset; | ||||
2292 | } | ||||
2293 | } | ||||
2294 | |||||
2295 | # remove a callback set to the callback stack | ||||
2296 | # if a callback set is passed, this function will check for the match function | ||||
2297 | sub unregister_callbacks { | ||||
2298 | my $self = shift; | ||||
2299 | my $cbset = shift; | ||||
2300 | if ( ref $cbset eq "ARRAY" and scalar( @$cbset ) == 4 ) { | ||||
2301 | $self->{_CALLBACKS} = [grep { $_->[0] != $cbset->[0] } @{$self->{_CALLBACKS}}]; | ||||
2302 | } | ||||
2303 | else { | ||||
2304 | shift @{$self->{_CALLBACKS}}; | ||||
2305 | } | ||||
2306 | } | ||||
2307 | |||||
2308 | # make libxml2 use the callbacks | ||||
2309 | sub init_callbacks { | ||||
2310 | my $self = shift; | ||||
2311 | my $parser = shift; | ||||
2312 | |||||
2313 | #initialize the libxml2 callbacks unless this is a nested callback | ||||
2314 | $self->lib_init_callbacks() unless($_CB_NESTED_DEPTH); | ||||
2315 | |||||
2316 | #store the callbacks for any outer executing parser instance | ||||
2317 | $_CB_NESTED_DEPTH++; | ||||
2318 | push @_CB_NESTED_STACK, [ | ||||
2319 | $_CUR_CB, | ||||
2320 | [@_CB_STACK], | ||||
2321 | [@_GLOBAL_CALLBACKS], | ||||
2322 | ]; | ||||
2323 | |||||
2324 | #initialize the callback variables for the current parser | ||||
2325 | $_CUR_CB = undef; | ||||
2326 | @_CB_STACK = (); | ||||
2327 | @_GLOBAL_CALLBACKS = @{ $self->{_CALLBACKS} }; | ||||
2328 | |||||
2329 | #attach parser specific callbacks | ||||
2330 | if($parser) { | ||||
2331 | my $mcb = $parser->match_callback(); | ||||
2332 | my $ocb = $parser->open_callback(); | ||||
2333 | my $rcb = $parser->read_callback(); | ||||
2334 | my $ccb = $parser->close_callback(); | ||||
2335 | if ( defined $mcb and defined $ocb and defined $rcb and defined $ccb ) { | ||||
2336 | unshift @_GLOBAL_CALLBACKS, [$mcb, $ocb, $rcb, $ccb]; | ||||
2337 | } | ||||
2338 | } | ||||
2339 | |||||
2340 | #attach global callbacks | ||||
2341 | if ( defined $XML::LibXML::match_cb and | ||||
2342 | defined $XML::LibXML::open_cb and | ||||
2343 | defined $XML::LibXML::read_cb and | ||||
2344 | defined $XML::LibXML::close_cb ) { | ||||
2345 | push @_GLOBAL_CALLBACKS, [$XML::LibXML::match_cb, | ||||
2346 | $XML::LibXML::open_cb, | ||||
2347 | $XML::LibXML::read_cb, | ||||
2348 | $XML::LibXML::close_cb]; | ||||
2349 | } | ||||
2350 | } | ||||
2351 | |||||
2352 | # reset libxml2's callbacks | ||||
2353 | sub cleanup_callbacks { | ||||
2354 | my $self = shift; | ||||
2355 | |||||
2356 | #restore the callbacks for the outer parser instance | ||||
2357 | $_CB_NESTED_DEPTH--; | ||||
2358 | my $saved = pop @_CB_NESTED_STACK; | ||||
2359 | $_CUR_CB = $saved->[0]; | ||||
2360 | @_CB_STACK = (@{$saved->[1]}); | ||||
2361 | @_GLOBAL_CALLBACKS = (@{$saved->[2]}); | ||||
2362 | |||||
2363 | #clean up the libxml2 callbacks unless there are still outer parsing instances | ||||
2364 | $self->lib_cleanup_callbacks() unless($_CB_NESTED_DEPTH); | ||||
2365 | } | ||||
2366 | |||||
2367 | $XML::LibXML::__loaded=1; | ||||
2368 | |||||
2369 | 1; | ||||
2370 | |||||
2371 | __END__ | ||||
# spent 75µs within XML::LibXML::END which was called:
# once (75µs+0s) by main::RUNTIME at line 0 of /usr/local/libexec/sympa/task_manager-debug.pl |