From 6e39f66db0a7cb461ec5be9a5b1517ec21955a08 Mon Sep 17 00:00:00 2001 From: David R Newman Date: Wed, 4 Nov 2026 11:43:47 +0000 Subject: [PATCH 1/3] Adds protection against XXE during imports (#624) - Use XML::SAX::ExpatXS rather than XML::LibXML::SAX so entity expansion can be disabled for EPrints::XML::LibXML->event_parse. Stops XXE in EPrints XML import. - Disable various XML import plugins unless XML::SAX::ExpatXS is installed to prevent import failing with unsightly error message. - Allow EPrints::XML->parse_url and EPrints::XML::LibXML->_parse_url to be called with second parameter to disable entity expansion by creating a new parser without expand_entities and load_ext_dtd attibutes set to true. Stops possible XXE in DOI import. - Remove expand_entities and load_ext_dtd from parser created in EPrints::Plugin::Import::XSLT->input_fh to prevent XXE in XSLT-based import plugins. - Remove support for other XML libraries beyond XML::LibXML and remove out-of-date / no longer required XML libraries under perl_lib/XML/, which should be installed at an operating system level if still needed. (See dnf/apt commands above). --- flavours/pub_lib/cfg.d/z_no_expatxs.pl | 10 + .../plugins/EPrints/Plugin/Import/DOI.pm | 2 +- .../plugins/EPrints/Plugin/Import/XSLT.pm | 2 +- lib/cfg.d/z_no_expatxs.pl | 7 + perl_lib/EPrints/XML.pm | 27 +- perl_lib/EPrints/XML/LibXML.pm | 33 +- perl_lib/XML/DOM.pm | 5148 ----------------- perl_lib/XML/DOM/AttDef.pod | 36 - perl_lib/XML/DOM/AttlistDecl.pod | 45 - perl_lib/XML/DOM/Attr.pod | 67 - perl_lib/XML/DOM/CDATASection.pod | 31 - perl_lib/XML/DOM/CharacterData.pod | 87 - perl_lib/XML/DOM/Comment.pod | 14 - perl_lib/XML/DOM/DOMException.pm | 125 - perl_lib/XML/DOM/DOMImplementation.pod | 24 - perl_lib/XML/DOM/Document.pod | 220 - perl_lib/XML/DOM/DocumentFragment.pod | 40 - perl_lib/XML/DOM/DocumentType.pod | 182 - perl_lib/XML/DOM/Element.pod | 189 - perl_lib/XML/DOM/ElementDecl.pod | 27 - perl_lib/XML/DOM/Entity.pod | 56 - perl_lib/XML/DOM/EntityReference.pod | 27 - perl_lib/XML/DOM/NamedNodeMap.pm | 308 - perl_lib/XML/DOM/NamedNodeMap.pod | 130 - perl_lib/XML/DOM/Node.pod | 451 -- perl_lib/XML/DOM/NodeList.pm | 83 - perl_lib/XML/DOM/NodeList.pod | 46 - perl_lib/XML/DOM/Notation.pod | 47 - perl_lib/XML/DOM/Parser.pod | 66 - perl_lib/XML/DOM/PerlSAX.pm | 79 - perl_lib/XML/DOM/ProcessingInstruction.pod | 32 - perl_lib/XML/DOM/Text.pod | 60 - perl_lib/XML/DOM/XMLDecl.pod | 33 - perl_lib/XML/NamespaceSupport.pm | 583 -- perl_lib/XML/RegExp.pm | 113 - perl_lib/XML/SAX/Base.pm | 3195 ---------- perl_lib/XML/SAX/Exception.pm | 157 - 37 files changed, 47 insertions(+), 11735 deletions(-) create mode 100644 flavours/pub_lib/cfg.d/z_no_expatxs.pl create mode 100644 lib/cfg.d/z_no_expatxs.pl delete mode 100644 perl_lib/XML/DOM.pm delete mode 100644 perl_lib/XML/DOM/AttDef.pod delete mode 100644 perl_lib/XML/DOM/AttlistDecl.pod delete mode 100644 perl_lib/XML/DOM/Attr.pod delete mode 100644 perl_lib/XML/DOM/CDATASection.pod delete mode 100644 perl_lib/XML/DOM/CharacterData.pod delete mode 100644 perl_lib/XML/DOM/Comment.pod delete mode 100644 perl_lib/XML/DOM/DOMException.pm delete mode 100644 perl_lib/XML/DOM/DOMImplementation.pod delete mode 100644 perl_lib/XML/DOM/Document.pod delete mode 100644 perl_lib/XML/DOM/DocumentFragment.pod delete mode 100644 perl_lib/XML/DOM/DocumentType.pod delete mode 100644 perl_lib/XML/DOM/Element.pod delete mode 100644 perl_lib/XML/DOM/ElementDecl.pod delete mode 100644 perl_lib/XML/DOM/Entity.pod delete mode 100644 perl_lib/XML/DOM/EntityReference.pod delete mode 100644 perl_lib/XML/DOM/NamedNodeMap.pm delete mode 100644 perl_lib/XML/DOM/NamedNodeMap.pod delete mode 100644 perl_lib/XML/DOM/Node.pod delete mode 100644 perl_lib/XML/DOM/NodeList.pm delete mode 100644 perl_lib/XML/DOM/NodeList.pod delete mode 100644 perl_lib/XML/DOM/Notation.pod delete mode 100644 perl_lib/XML/DOM/Parser.pod delete mode 100644 perl_lib/XML/DOM/PerlSAX.pm delete mode 100644 perl_lib/XML/DOM/ProcessingInstruction.pod delete mode 100644 perl_lib/XML/DOM/Text.pod delete mode 100644 perl_lib/XML/DOM/XMLDecl.pod delete mode 100644 perl_lib/XML/NamespaceSupport.pm delete mode 100644 perl_lib/XML/RegExp.pm delete mode 100644 perl_lib/XML/SAX/Base.pm delete mode 100644 perl_lib/XML/SAX/Exception.pm diff --git a/flavours/pub_lib/cfg.d/z_no_expatxs.pl b/flavours/pub_lib/cfg.d/z_no_expatxs.pl new file mode 100644 index 0000000..74a4a33 --- /dev/null +++ b/flavours/pub_lib/cfg.d/z_no_expatxs.pl @@ -0,0 +1,10 @@ +# If XML::SAX::ExpatXS is not installed disable XML import. +use Module::Load::Conditional qw(check_install); +if ( !check_install(module => "XML::SAX::ExpatXS") ) +{ + $c->{plugins}->{"Import::XML"}->{params}->{disable} = 1; + $c->{plugins}->{"Import::ISIWoKXML"}->{params}->{disable} = 1; + $c->{plugins}->{"Import::PubMedID"}->{params}->{disable} = 1; + $c->{plugins}->{"Import::PubMedXML"}->{params}->{disable} = 1; + $c->{plugins}->{"Import::DefaultXML"}->{params}->{disable} = 1; +} diff --git a/flavours/pub_lib/plugins/EPrints/Plugin/Import/DOI.pm b/flavours/pub_lib/plugins/EPrints/Plugin/Import/DOI.pm index 53d4647..7c5770f 100644 --- a/flavours/pub_lib/plugins/EPrints/Plugin/Import/DOI.pm +++ b/flavours/pub_lib/plugins/EPrints/Plugin/Import/DOI.pm @@ -122,7 +122,7 @@ sub input_text_fh my $dom_doc; my $dom_crossref; eval { - $dom_doc = EPrints::XML::parse_url( $url ); + $dom_doc = EPrints::XML::parse_url( $url, 1 ); $dom_crossref = ($dom_doc->findnodes( "doi_records/doi_record/crossref" ))[0]; }; diff --git a/flavours/pub_lib/plugins/EPrints/Plugin/Import/XSLT.pm b/flavours/pub_lib/plugins/EPrints/Plugin/Import/XSLT.pm index 99633e9..15c6621 100644 --- a/flavours/pub_lib/plugins/EPrints/Plugin/Import/XSLT.pm +++ b/flavours/pub_lib/plugins/EPrints/Plugin/Import/XSLT.pm @@ -46,7 +46,7 @@ sub input_fh # read the source XML # note: LibXSLT will only work with LibXML, so that's what we use here - my $source = XML::LibXML->new( expand_entities=>1, load_external_dtd=>1 )->parse_fh( $fh ); + my $source = XML::LibXML->new->parse_fh( $fh ); # transform it using our stylesheet my $result = $self->transform( $source ); diff --git a/lib/cfg.d/z_no_expatxs.pl b/lib/cfg.d/z_no_expatxs.pl new file mode 100644 index 0000000..06aad43 --- /dev/null +++ b/lib/cfg.d/z_no_expatxs.pl @@ -0,0 +1,7 @@ +# If XML::SAX::ExpatXS is not installed disable XML import. +use Module::Load::Conditional qw(check_install); +if ( !check_install(module => "XML::SAX::ExpatXS") ) +{ + $c->{plugins}->{"Import::XML"}->{params}->{disable} = 1; + $c->{plugins}->{"Import::DefaultXML"}->{params}->{disable} = 1; +} diff --git a/perl_lib/EPrints/XML.pm b/perl_lib/EPrints/XML.pm index 027e08f..29aad54 100644 --- a/perl_lib/EPrints/XML.pm +++ b/perl_lib/EPrints/XML.pm @@ -64,26 +64,10 @@ $EPrints::XML::CLASS = undef; sub init { - my $c = $EPrints::SystemSettings::conf; - my $disable_libxml = exists $c->{enable_libxml} && !$c->{enable_libxml}; - my $disable_gdome = exists $c->{enable_gdome} && !$c->{enable_gdome}; + eval "use EPrints::XML::LibXML; 1"; + return 1 if !$@; - if( !$disable_libxml ) - { - eval "use EPrints::XML::LibXML; 1"; - return 1 if !$@; - } - - print STDERR "*** DEPRECATION WARNING *** -In future versions, EPrints will be standardising to only support the LibXML library for providing XML functionality. Please ensure LibXML is installed before upgrading EPrints.\n"; - - if( !$disable_gdome ) - { - eval "use EPrints::XML::GDOME; 1"; - return 1 if !$@; - } - - require EPrints::XML::DOM; + EPrints->abort( "*** DEPRECATION NOTICE - EPrints has standardised to only support the LibXML library for providing XML functionality. Please ensure the Perl module XML::LibXML is installed. ***" ); } use strict; @@ -147,7 +131,7 @@ sub parse_file return parse_xml( $filename, $opts{base_path}, $opts{no_expand} ); } -=item $doc = $xml->parse_url( $url ) +=item $doc = $xml->parse_url( $url, $no_expand ) Returns an XML document parsed from the content located at $url. @@ -155,7 +139,8 @@ Returns an XML document parsed from the content located at $url. sub parse_url { - return _parse_url( pop(@_) ); + my ( $url, $no_expand ) = @_; + return _parse_url( $url, $no_expand ); } =back diff --git a/perl_lib/EPrints/XML/LibXML.pm b/perl_lib/EPrints/XML/LibXML.pm index 4674d32..695de55 100644 --- a/perl_lib/EPrints/XML/LibXML.pm +++ b/perl_lib/EPrints/XML/LibXML.pm @@ -105,11 +105,18 @@ sub _parse_url { my( $url, $no_expand ) = @_; - return $PARSER->parse_file( "$url" ) if substr( $url, 0, 6 ) ne "https:"; + # Use non-expanding parser if expressly asked. + my $parser = $PARSER; + if ( $no_expand ) + { + $parser = XML::LibXML->new; + } + + return $parser->parse_file( "$url" ) if substr( $url, 0, 6 ) ne "https:"; use LWP::Simple qw(get); my $string = get( $url ); - return $PARSER->parse_string( $string ); + return $parser->parse_string( $string ); } =item $doc = parse_xml( $filename [, $basepath [, $no_expand]] ) @@ -146,21 +153,25 @@ sub event_parse { my( $fh, $handler ) = @_; - # XML::LibXML causes a "stack smashing detected" on utf8 input FHs. The XML - # library ought to read the declaration anyway, to determine the - # encoding - binmode($fh); - - my $parser; + # Do not use XML::LibXML::SAX as it does not support disabling entities, which + # could be used for XML external entity (XXE) injection. XML::SAX::ExpatXS is + # also an old library and will be replaced in a future version of EPrints. if( EPrints::Utils::require_if_exists( 'XML::SAX::ExpatXS' ) ) { - $parser = XML::SAX::ExpatXS->new( Handler => $handler ); + binmode($fh); + + my $parser = XML::SAX::ExpatXS->new( Handler => $handler ); + + # Disable entity expansion to prevent XXE. + $parser->set_feature("http://xml.org/sax/features/external-general-entities", 0); + $parser->set_feature("http://xml.org/sax/features/external-parameter-entities", 0); + + $parser->parse_file( $fh ); } else { - $parser = XML::LibXML::SAX->new( Handler => $handler ); + EPrints::abort( "Can't read XML file: XML::SAX::ExpatXS module is not installed." ); } - $parser->parse_file( $fh ); } diff --git a/perl_lib/XML/DOM.pm b/perl_lib/XML/DOM.pm deleted file mode 100644 index 4f336c5..0000000 --- a/perl_lib/XML/DOM.pm +++ /dev/null @@ -1,5148 +0,0 @@ -################################################################################ -# -# Perl module: XML::DOM -# -# By Enno Derksen -# -################################################################################ -# -# To do: -# -# * optimize Attr if it only contains 1 Text node to hold the value -# * fix setDocType! -# -# * BUG: setOwnerDocument - does not process default attr values correctly, -# they still point to the old doc. -# * change Exception mechanism -# * maybe: more checking of sysId etc. -# * NoExpand mode (don't know what else is useful) -# * various odds and ends: see comments starting with "??" -# * normalize(1) could also expand CDataSections and EntityReferences -# * parse a DocumentFragment? -# * encoding support -# -###################################################################### - -###################################################################### -package XML::DOM; -###################################################################### - -use strict; - -use bytes; - -use vars qw( $VERSION @ISA @EXPORT - $IgnoreReadOnly $SafeMode $TagStyle - %DefaultEntities %DecodeDefaultEntity - ); -use Carp; -use XML::RegExp; - -BEGIN -{ - require XML::Parser; - $VERSION = '1.36'; - - my $needVersion = '2.28'; - die "need at least XML::Parser version $needVersion (current=${XML::Parser::VERSION})" - unless $XML::Parser::VERSION >= $needVersion; - - @ISA = qw( Exporter ); - - # Constants for XML::DOM Node types - @EXPORT = qw( - UNKNOWN_NODE - ELEMENT_NODE - ATTRIBUTE_NODE - TEXT_NODE - CDATA_SECTION_NODE - ENTITY_REFERENCE_NODE - ENTITY_NODE - PROCESSING_INSTRUCTION_NODE - COMMENT_NODE - DOCUMENT_NODE - DOCUMENT_TYPE_NODE - DOCUMENT_FRAGMENT_NODE - NOTATION_NODE - ELEMENT_DECL_NODE - ATT_DEF_NODE - XML_DECL_NODE - ATTLIST_DECL_NODE - ); -} - -#---- Constant definitions - -# Node types - -sub UNKNOWN_NODE () { 0 } # not in the DOM Spec - -sub ELEMENT_NODE () { 1 } -sub ATTRIBUTE_NODE () { 2 } -sub TEXT_NODE () { 3 } -sub CDATA_SECTION_NODE () { 4 } -sub ENTITY_REFERENCE_NODE () { 5 } -sub ENTITY_NODE () { 6 } -sub PROCESSING_INSTRUCTION_NODE () { 7 } -sub COMMENT_NODE () { 8 } -sub DOCUMENT_NODE () { 9 } -sub DOCUMENT_TYPE_NODE () { 10} -sub DOCUMENT_FRAGMENT_NODE () { 11} -sub NOTATION_NODE () { 12} - -sub ELEMENT_DECL_NODE () { 13 } # not in the DOM Spec -sub ATT_DEF_NODE () { 14 } # not in the DOM Spec -sub XML_DECL_NODE () { 15 } # not in the DOM Spec -sub ATTLIST_DECL_NODE () { 16 } # not in the DOM Spec - -%DefaultEntities = -( - "quot" => '"', - "gt" => ">", - "lt" => "<", - "apos" => "'", - "amp" => "&" -); - -%DecodeDefaultEntity = -( - '"' => """, - ">" => ">", - "<" => "<", - "'" => "'", - "&" => "&" -); - -# -# If you don't want DOM warnings to use 'warn', override this method like this: -# -# { # start block scope -# local *XML::DOM::warning = \&my_warn; -# ... your code here ... -# } # end block scope (old XML::DOM::warning takes effect again) -# -sub warning # static -{ - warn @_; -} - -# -# This method defines several things in the caller's package, so you can use named constants to -# access the array that holds the member data, i.e. $self->[_Data]. It assumes the caller's package -# defines a class that is implemented as a blessed array reference. -# Note that this is very similar to using 'use fields' and 'use base'. -# -# E.g. if $fields eq "Name Model", $parent eq "XML::DOM::Node" and -# XML::DOM::Node had "A B C" as fields and it was called from package "XML::DOM::ElementDecl", -# then this code would basically do the following: -# -# package XML::DOM::ElementDecl; -# -# sub _Name () { 3 } # Note that parent class had three fields -# sub _Model () { 4 } -# -# # Maps constant names (without '_') to constant (int) value -# %HFIELDS = ( %XML::DOM::Node::HFIELDS, Name => _Name, Model => _Model ); -# -# # Define XML:DOM::ElementDecl as a subclass of XML::DOM::Node -# @ISA = qw{ XML::DOM::Node }; -# -# # The following function names can be exported into the user's namespace. -# @EXPORT_OK = qw{ _Name _Model }; -# -# # The following function names can be exported into the user's namespace -# # with: import XML::DOM::ElementDecl qw( :Fields ); -# %EXPORT_TAGS = ( Fields => qw{ _Name _Model } ); -# -sub def_fields # static -{ - my ($fields, $parent) = @_; - - my ($pkg) = caller; - - no strict 'refs'; - - my @f = split (/\s+/, $fields); - my $n = 0; - - my %hfields; - if (defined $parent) - { - my %pf = %{"$parent\::HFIELDS"}; - %hfields = %pf; - - $n = scalar (keys %pf); - @{"$pkg\::ISA"} = ( $parent ); - } - - my $i = $n; - for (@f) - { - eval "sub $pkg\::_$_ () { $i }"; - $hfields{$_} = $i; - $i++; - } - %{"$pkg\::HFIELDS"} = %hfields; - @{"$pkg\::EXPORT_OK"} = map { "_$_" } @f; - - ${"$pkg\::EXPORT_TAGS"}{Fields} = [ map { "_$_" } @f ]; -} - -# sub blesh -# { -# my $hashref = shift; -# my $class = shift; -# no strict 'refs'; -# my $self = bless [\%{"$class\::FIELDS"}], $class; -# if (defined $hashref) -# { -# for (keys %$hashref) -# { -# $self->{$_} = $hashref->{$_}; -# } -# } -# $self; -# } - -# sub blesh2 -# { -# my $hashref = shift; -# my $class = shift; -# no strict 'refs'; -# my $self = bless [\%{"$class\::FIELDS"}], $class; -# if (defined $hashref) -# { -# for (keys %$hashref) -# { -# eval { $self->{$_} = $hashref->{$_}; }; -# croak "ERROR in field [$_] $@" if $@; -# } -# } -# $self; -#} - -# -# CDATA section may not contain "]]>" -# -sub encodeCDATA -{ - my ($str) = shift; - $str =~ s/]]>/]]>/go; - $str; -} - -# -# PI may not contain "?>" -# -sub encodeProcessingInstruction -{ - my ($str) = shift; - $str =~ s/\?>/?>/go; - $str; -} - -# -#?? Not sure if this is right - must prevent double minus somehow... -# -sub encodeComment -{ - my ($str) = shift; - return undef unless defined $str; - - $str =~ s/--/--/go; - $str; -} - -# -# For debugging -# -sub toHex -{ - my $str = shift; - my $len = length($str); - my @a = unpack ("C$len", $str); - my $s = ""; - for (@a) - { - $s .= sprintf ("%02x", $_); - } - $s; -} - -# -# 2nd parameter $default: list of Default Entity characters that need to be -# converted (e.g. "&<" for conversion to "&" and "<" resp.) -# -sub encodeText -{ - my ($str, $default) = @_; - return undef unless defined $str; - -############ - if ($] >= 5.006) { - no bytes; # Fixes error while trying to process "\"ü" - $str =~ s/([$default])|(]]>)/ - defined ($1) ? $DecodeDefaultEntity{$1} : "]]>" /egs; - } -############ - else { - $str =~ s/([\xC0-\xDF].|[\xE0-\xEF]..|[\xF0-\xFF]...)|([$default])|(]]>)/ - defined($1) ? XmlUtf8Decode ($1) : - defined ($2) ? $DecodeDefaultEntity{$2} : "]]>" /egs; - } - -#?? could there be references that should not be expanded? -# e.g. should not replace &#nn; ¯ and &abc; -# $str =~ s/&(?!($ReName|#[0-9]+|#x[0-9a-fA-F]+);)/&/go; - - $str; -} - -# -# Used by AttDef - default value -# -sub encodeAttrValue -{ - encodeText (shift, '"&<>'); -} - -# -# Converts an integer (Unicode - ISO/IEC 10646) to a UTF-8 encoded character -# sequence. -# Used when converting e.g. { or Ͽ to a string value. -# -# Algorithm borrowed from expat/xmltok.c/XmlUtf8Encode() -# -# not checking for bad characters: < 0, x00-x08, x0B-x0C, x0E-x1F, xFFFE-xFFFF -# -sub XmlUtf8Encode -{ - my $n = shift; - if ($n < 0x80) - { - return chr ($n); - } - elsif ($n < 0x800) - { - return pack ("CC", (($n >> 6) | 0xc0), (($n & 0x3f) | 0x80)); - } - elsif ($n < 0x10000) - { - return pack ("CCC", (($n >> 12) | 0xe0), ((($n >> 6) & 0x3f) | 0x80), - (($n & 0x3f) | 0x80)); - } - elsif ($n < 0x110000) - { - return pack ("CCCC", (($n >> 18) | 0xf0), ((($n >> 12) & 0x3f) | 0x80), - ((($n >> 6) & 0x3f) | 0x80), (($n & 0x3f) | 0x80)); - } - croak "number is too large for Unicode [$n] in &XmlUtf8Encode"; -} - -# -# Opposite of XmlUtf8Decode plus it adds prefix "&#" or "&#x" and suffix ";" -# The 2nd parameter ($hex) indicates whether the result is hex encoded or not. -# -sub XmlUtf8Decode -{ - my ($str, $hex) = @_; - my $len = length ($str); - my $n; - - if ($len == 2) - { - my @n = unpack "C2", $str; - $n = (($n[0] & 0x3f) << 6) + ($n[1] & 0x3f); - } - elsif ($len == 3) - { - my @n = unpack "C3", $str; - $n = (($n[0] & 0x1f) << 12) + (($n[1] & 0x3f) << 6) + - ($n[2] & 0x3f); - } - elsif ($len == 4) - { - my @n = unpack "C4", $str; - $n = (($n[0] & 0x0f) << 18) + (($n[1] & 0x3f) << 12) + - (($n[2] & 0x3f) << 6) + ($n[3] & 0x3f); - } - elsif ($len == 1) # just to be complete... - { - $n = ord ($str); - } - else - { - croak "bad value [$str] for XmlUtf8Decode"; - } - $hex ? sprintf ("&#x%x;", $n) : "&#$n;"; -} - -$IgnoreReadOnly = 0; -$SafeMode = 1; - -sub getIgnoreReadOnly -{ - $IgnoreReadOnly; -} - -# -# The global flag $IgnoreReadOnly is set to the specified value and the old -# value of $IgnoreReadOnly is returned. -# -# To temporarily disable read-only related exceptions (i.e. when parsing -# XML or temporarily), do the following: -# -# my $oldIgnore = XML::DOM::ignoreReadOnly (1); -# ... do whatever you want ... -# XML::DOM::ignoreReadOnly ($oldIgnore); -# -sub ignoreReadOnly -{ - my $i = $IgnoreReadOnly; - $IgnoreReadOnly = $_[0]; - return $i; -} - -# -# XML spec seems to break its own rules... (see ENTITY xmlpio) -# -sub forgiving_isValidName -{ - $_[0] =~ /^$XML::RegExp::Name$/o; -} - -# -# Don't allow names starting with xml (either case) -# -sub picky_isValidName -{ - $_[0] =~ /^$XML::RegExp::Name$/o and $_[0] !~ /^xml/i; -} - -# Be forgiving by default, -*isValidName = \&forgiving_isValidName; - -sub allowReservedNames # static -{ - *isValidName = ($_[0] ? \&forgiving_isValidName : \&picky_isValidName); -} - -sub getAllowReservedNames # static -{ - *isValidName == \&forgiving_isValidName; -} - -# -# Always compress empty tags by default -# This is used by Element::print. -# -$TagStyle = sub { 0 }; - -sub setTagCompression -{ - $TagStyle = shift; -} - -###################################################################### -package XML::DOM::PrintToFileHandle; -###################################################################### - -# -# Used by XML::DOM::Node::printToFileHandle -# - -sub new -{ - my($class, $fn) = @_; - bless $fn, $class; -} - -sub print -{ - my ($self, $str) = @_; - print $self $str; -} - -###################################################################### -package XML::DOM::PrintToString; -###################################################################### - -use vars qw{ $Singleton }; - -# -# Used by XML::DOM::Node::toString to concatenate strings -# - -sub new -{ - my($class) = @_; - my $str = ""; - bless \$str, $class; -} - -sub print -{ - my ($self, $str) = @_; - $$self .= $str; -} - -sub toString -{ - my $self = shift; - $$self; -} - -sub reset -{ - ${$_[0]} = ""; -} - -$Singleton = new XML::DOM::PrintToString; - -###################################################################### -package XML::DOM::DOMImplementation; -###################################################################### - -$XML::DOM::DOMImplementation::Singleton = - bless \$XML::DOM::DOMImplementation::Singleton, 'XML::DOM::DOMImplementation'; - -sub hasFeature -{ - my ($self, $feature, $version) = @_; - - uc($feature) eq 'XML' and ($version eq '1.0' || $version eq ''); -} - - -###################################################################### -package XML::XQL::Node; # forward declaration -###################################################################### - -###################################################################### -package XML::DOM::Node; -###################################################################### - -use vars qw( @NodeNames @EXPORT @ISA %HFIELDS @EXPORT_OK @EXPORT_TAGS ); - -BEGIN -{ - use XML::DOM::DOMException; - import Carp; - - require FileHandle; - - @ISA = qw( Exporter XML::XQL::Node ); - - # NOTE: SortKey is used in XML::XQL::Node. - # UserData is reserved for users (Hang your data here!) - XML::DOM::def_fields ("C A Doc Parent ReadOnly UsedIn Hidden SortKey UserData"); - - push (@EXPORT, qw( - UNKNOWN_NODE - ELEMENT_NODE - ATTRIBUTE_NODE - TEXT_NODE - CDATA_SECTION_NODE - ENTITY_REFERENCE_NODE - ENTITY_NODE - PROCESSING_INSTRUCTION_NODE - COMMENT_NODE - DOCUMENT_NODE - DOCUMENT_TYPE_NODE - DOCUMENT_FRAGMENT_NODE - NOTATION_NODE - ELEMENT_DECL_NODE - ATT_DEF_NODE - XML_DECL_NODE - ATTLIST_DECL_NODE - )); -} - -#---- Constant definitions - -# Node types - -sub UNKNOWN_NODE () {0;} # not in the DOM Spec - -sub ELEMENT_NODE () {1;} -sub ATTRIBUTE_NODE () {2;} -sub TEXT_NODE () {3;} -sub CDATA_SECTION_NODE () {4;} -sub ENTITY_REFERENCE_NODE () {5;} -sub ENTITY_NODE () {6;} -sub PROCESSING_INSTRUCTION_NODE () {7;} -sub COMMENT_NODE () {8;} -sub DOCUMENT_NODE () {9;} -sub DOCUMENT_TYPE_NODE () {10;} -sub DOCUMENT_FRAGMENT_NODE () {11;} -sub NOTATION_NODE () {12;} - -sub ELEMENT_DECL_NODE () {13;} # not in the DOM Spec -sub ATT_DEF_NODE () {14;} # not in the DOM Spec -sub XML_DECL_NODE () {15;} # not in the DOM Spec -sub ATTLIST_DECL_NODE () {16;} # not in the DOM Spec - -@NodeNames = ( - "UNKNOWN_NODE", # not in the DOM Spec! - - "ELEMENT_NODE", - "ATTRIBUTE_NODE", - "TEXT_NODE", - "CDATA_SECTION_NODE", - "ENTITY_REFERENCE_NODE", - "ENTITY_NODE", - "PROCESSING_INSTRUCTION_NODE", - "COMMENT_NODE", - "DOCUMENT_NODE", - "DOCUMENT_TYPE_NODE", - "DOCUMENT_FRAGMENT_NODE", - "NOTATION_NODE", - - "ELEMENT_DECL_NODE", - "ATT_DEF_NODE", - "XML_DECL_NODE", - "ATTLIST_DECL_NODE" - ); - -sub decoupleUsedIn -{ - my $self = shift; - undef $self->[_UsedIn]; # was delete -} - -sub getParentNode -{ - $_[0]->[_Parent]; -} - -sub appendChild -{ - my ($self, $node) = @_; - - # REC 7473 - if ($XML::DOM::SafeMode) - { - croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, - "node is ReadOnly") - if $self->isReadOnly; - } - - my $doc = $self->[_Doc]; - -#cjg start hack - if( !defined $node ) - { - croak "Attempt to append undef'd node!"; - } - if( ref($node) eq "" ) - { - croak "Attempt to append non blessed node!"; - } -#cjg end hack - - if ($node->isDocumentFragmentNode) - { - if ($XML::DOM::SafeMode) - { - for my $n (@{$node->[_C]}) - { - croak new XML::DOM::DOMException (WRONG_DOCUMENT_ERR, - "nodes belong to different documents") - if $doc != $n->[_Doc]; - - croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR, - "node is ancestor of parent node") - if $n->isAncestor ($self); - - croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR, - "bad node type") - if $self->rejectChild ($n); - } - } - - my @list = @{$node->[_C]}; # don't try to compress this - for my $n (@list) - { - $n->setParentNode ($self); - } - push @{$self->[_C]}, @list; - } - else - { - if ($XML::DOM::SafeMode) - { - croak new XML::DOM::DOMException (WRONG_DOCUMENT_ERR, - "nodes belong to different documents") - if $doc != $node->[_Doc]; - - croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR, - "node is ancestor of parent node") - if $node->isAncestor ($self); - - croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR, - "bad node type") - if $self->rejectChild ($node); - } - $node->setParentNode ($self); - push @{$self->[_C]}, $node; - } - $node; -} - -sub getChildNodes -{ - # NOTE: if node can't have children, $self->[_C] is undef. - my $kids = $_[0]->[_C]; - - # Return a list if called in list context. - wantarray ? (defined ($kids) ? @{ $kids } : ()) : - (defined ($kids) ? $kids : $XML::DOM::NodeList::EMPTY); -} - -sub hasChildNodes -{ - my $kids = $_[0]->[_C]; - defined ($kids) && @$kids > 0; -} - -# This method is overridden in Document -sub getOwnerDocument -{ - $_[0]->[_Doc]; -} - -sub getFirstChild -{ - my $kids = $_[0]->[_C]; - defined $kids ? $kids->[0] : undef; -} - -sub getLastChild -{ - my $kids = $_[0]->[_C]; - defined $kids ? $kids->[-1] : undef; -} - -sub getPreviousSibling -{ - my $self = shift; - - my $pa = $self->[_Parent]; - return undef unless $pa; - my $index = $pa->getChildIndex ($self); - return undef unless $index; - - $pa->getChildAtIndex ($index - 1); -} - -sub getNextSibling -{ - my $self = shift; - - my $pa = $self->[_Parent]; - return undef unless $pa; - - $pa->getChildAtIndex ($pa->getChildIndex ($self) + 1); -} - -sub insertBefore -{ - my ($self, $node, $refNode) = @_; - - return $self->appendChild ($node) unless $refNode; # append at the end - - croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, - "node is ReadOnly") - if $self->isReadOnly; - - my @nodes = ($node); - @nodes = @{$node->[_C]} - if $node->getNodeType == DOCUMENT_FRAGMENT_NODE; - - my $doc = $self->[_Doc]; - - for my $n (@nodes) - { - croak new XML::DOM::DOMException (WRONG_DOCUMENT_ERR, - "nodes belong to different documents") - if $doc != $n->[_Doc]; - - croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR, - "node is ancestor of parent node") - if $n->isAncestor ($self); - - croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR, - "bad node type") - if $self->rejectChild ($n); - } - my $index = $self->getChildIndex ($refNode); - - croak new XML::DOM::DOMException (NOT_FOUND_ERR, - "reference node not found") - if $index == -1; - - for my $n (@nodes) - { - $n->setParentNode ($self); - } - - splice (@{$self->[_C]}, $index, 0, @nodes); - $node; -} - -sub replaceChild -{ - my ($self, $node, $refNode) = @_; - - croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, - "node is ReadOnly") - if $self->isReadOnly; - - my @nodes = ($node); - @nodes = @{$node->[_C]} - if $node->getNodeType == DOCUMENT_FRAGMENT_NODE; - - for my $n (@nodes) - { - croak new XML::DOM::DOMException (WRONG_DOCUMENT_ERR, - "nodes belong to different documents") - if $self->[_Doc] != $n->[_Doc]; - - croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR, - "node is ancestor of parent node") - if $n->isAncestor ($self); - - croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR, - "bad node type") - if $self->rejectChild ($n); - } - - my $index = $self->getChildIndex ($refNode); - croak new XML::DOM::DOMException (NOT_FOUND_ERR, - "reference node not found") - if $index == -1; - - for my $n (@nodes) - { - $n->setParentNode ($self); - } - splice (@{$self->[_C]}, $index, 1, @nodes); - - $refNode->removeChildHoodMemories; - $refNode; -} - -sub removeChild -{ - my ($self, $node) = @_; - - croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, - "node is ReadOnly") - if $self->isReadOnly; - - my $index = $self->getChildIndex ($node); - - croak new XML::DOM::DOMException (NOT_FOUND_ERR, - "reference node not found") - if $index == -1; - - splice (@{$self->[_C]}, $index, 1, ()); - - $node->removeChildHoodMemories; - $node; -} - -# Merge all subsequent Text nodes in this subtree -sub normalize -{ - my ($self) = shift; - my $prev = undef; # previous Text node - - return unless defined $self->[_C]; - - my @nodes = @{$self->[_C]}; - my $i = 0; - my $n = @nodes; - while ($i < $n) - { - my $node = $self->getChildAtIndex($i); - my $type = $node->getNodeType; - - if (defined $prev) - { - # It should not merge CDATASections. Dom Spec says: - # Adjacent CDATASections nodes are not merged by use - # of the Element.normalize() method. - if ($type == TEXT_NODE) - { - $prev->appendData ($node->getData); - $self->removeChild ($node); - $i--; - $n--; - } - else - { - $prev = undef; - if ($type == ELEMENT_NODE) - { - $node->normalize; - if (defined $node->[_A]) - { - for my $attr (@{$node->[_A]->getValues}) - { - $attr->normalize; - } - } - } - } - } - else - { - if ($type == TEXT_NODE) - { - $prev = $node; - } - elsif ($type == ELEMENT_NODE) - { - $node->normalize; - if (defined $node->[_A]) - { - for my $attr (@{$node->[_A]->getValues}) - { - $attr->normalize; - } - } - } - } - $i++; - } -} - -# -# Return all Element nodes in the subtree that have the specified tagName. -# If tagName is "*", all Element nodes are returned. -# NOTE: the DOM Spec does not specify a 3rd or 4th parameter -# -sub getElementsByTagName -{ - my ($self, $tagName, $recurse, $list) = @_; - $recurse = 1 unless defined $recurse; - $list = (wantarray ? [] : new XML::DOM::NodeList) unless defined $list; - - return unless defined $self->[_C]; - - # preorder traversal: check parent node first - for my $kid (@{$self->[_C]}) - { - if ($kid->isElementNode) - { - if ($tagName eq "*" || $tagName eq $kid->getTagName) - { - push @{$list}, $kid; - } - $kid->getElementsByTagName ($tagName, $recurse, $list) if $recurse; - } - } - wantarray ? @{ $list } : $list; -} - -sub getNodeValue -{ - undef; -} - -sub setNodeValue -{ - # no-op -} - -# -# Redefined by XML::DOM::Element -# -sub getAttributes -{ - undef; -} - -#------------------------------------------------------------ -# Extra method implementations - -sub setOwnerDocument -{ - my ($self, $doc) = @_; - $self->[_Doc] = $doc; - - return unless defined $self->[_C]; - - for my $kid (@{$self->[_C]}) - { - $kid->setOwnerDocument ($doc); - } -} - -sub cloneChildren -{ - my ($self, $node, $deep) = @_; - return unless $deep; - - return unless defined $self->[_C]; - - local $XML::DOM::IgnoreReadOnly = 1; - - for my $kid (@{$node->[_C]}) - { - my $newNode = $kid->cloneNode ($deep); - push @{$self->[_C]}, $newNode; - $newNode->setParentNode ($self); - } -} - -# -# For internal use only! -# -sub removeChildHoodMemories -{ - my ($self) = @_; - - undef $self->[_Parent]; # was delete -} - -# -# Remove circular dependencies. The Node and its children should -# not be used afterwards. -# -sub dispose -{ - my $self = shift; - - $self->removeChildHoodMemories; - - if (defined $self->[_C]) - { - $self->[_C]->dispose; - undef $self->[_C]; # was delete - } - undef $self->[_Doc]; # was delete -} - -# -# For internal use only! -# -sub setParentNode -{ - my ($self, $parent) = @_; - - # REC 7473 - my $oldParent = $self->[_Parent]; - if (defined $oldParent) - { - # remove from current parent - my $index = $oldParent->getChildIndex ($self); - - # NOTE: we don't have to check if [_C] is defined, - # because were removing a child here! - splice (@{$oldParent->[_C]}, $index, 1, ()); - - $self->removeChildHoodMemories; - } - $self->[_Parent] = $parent; -} - -# -# This function can return 3 values: -# 1: always readOnly -# 0: never readOnly -# undef: depends on parent node -# -# Returns 1 for DocumentType, Notation, Entity, EntityReference, Attlist, -# ElementDecl, AttDef. -# The first 4 are readOnly according to the DOM Spec, the others are always -# children of DocumentType. (Naturally, children of a readOnly node have to be -# readOnly as well...) -# These nodes are always readOnly regardless of who their ancestors are. -# Other nodes, e.g. Comment, are readOnly only if their parent is readOnly, -# which basically means that one of its ancestors has to be one of the -# aforementioned node types. -# Document and DocumentFragment return 0 for obvious reasons. -# Attr, Element, CDATASection, Text return 0. The DOM spec says that they can -# be children of an Entity, but I don't think that that's possible -# with the current XML::Parser. -# Attr uses a {ReadOnly} property, which is only set if it's part of a AttDef. -# Always returns 0 if ignoreReadOnly is set. -# -sub isReadOnly -{ - # default implementation for Nodes that are always readOnly - ! $XML::DOM::IgnoreReadOnly; -} - -sub rejectChild -{ - 1; -} - -sub getNodeTypeName -{ - $NodeNames[$_[0]->getNodeType]; -} - -sub getChildIndex -{ - my ($self, $node) = @_; - my $i = 0; - - return -1 unless defined $self->[_C]; - - for my $kid (@{$self->[_C]}) - { - return $i if $kid == $node; - $i++; - } - -1; -} - -sub getChildAtIndex -{ - my $kids = $_[0]->[_C]; - defined ($kids) ? $kids->[$_[1]] : undef; -} - -sub isAncestor -{ - my ($self, $node) = @_; - - do - { - return 1 if $self == $node; - $node = $node->[_Parent]; - } - while (defined $node); - - 0; -} - -# -# Added for optimization. Overridden in XML::DOM::Text -# -sub isTextNode -{ - 0; -} - -# -# Added for optimization. Overridden in XML::DOM::DocumentFragment -# -sub isDocumentFragmentNode -{ - 0; -} - -# -# Added for optimization. Overridden in XML::DOM::Element -# -sub isElementNode -{ - 0; -} - -# -# Add a Text node with the specified value or append the text to the -# previous Node if it is a Text node. -# -sub addText -{ - # REC 9456 (if it was called) - my ($self, $str) = @_; - - my $node = ${$self->[_C]}[-1]; # $self->getLastChild - - if (defined ($node) && $node->isTextNode) - { - # REC 5475 (if it was called) - $node->appendData ($str); - } - else - { - $node = $self->[_Doc]->createTextNode ($str); - $self->appendChild ($node); - } - $node; -} - -# -# Add a CDATASection node with the specified value or append the text to the -# previous Node if it is a CDATASection node. -# -sub addCDATA -{ - my ($self, $str) = @_; - - my $node = ${$self->[_C]}[-1]; # $self->getLastChild - - if (defined ($node) && $node->getNodeType == CDATA_SECTION_NODE) - { - $node->appendData ($str); - } - else - { - $node = $self->[_Doc]->createCDATASection ($str); - $self->appendChild ($node); - } - $node; -} - -sub removeChildNodes -{ - my $self = shift; - - my $cref = $self->[_C]; - return unless defined $cref; - - my $kid; - while ($kid = pop @{$cref}) - { - undef $kid->[_Parent]; # was delete - } -} - -sub toString -{ - my $self = shift; - my $pr = $XML::DOM::PrintToString::Singleton; - $pr->reset; - $self->print ($pr); - $pr->toString; -} - -sub to_sax -{ - my $self = shift; - unshift @_, 'Handler' if (@_ == 1); - my %h = @_; - - my $doch = exists ($h{DocumentHandler}) ? $h{DocumentHandler} - : $h{Handler}; - my $dtdh = exists ($h{DTDHandler}) ? $h{DTDHandler} - : $h{Handler}; - my $enth = exists ($h{EntityResolver}) ? $h{EntityResolver} - : $h{Handler}; - - $self->_to_sax ($doch, $dtdh, $enth); -} - -sub printToFile -{ - my ($self, $fileName) = @_; - my $fh = new FileHandle ($fileName, "w") || - croak "printToFile - can't open output file $fileName"; - - $self->print ($fh); - $fh->close; -} - -# -# Use print to print to a FileHandle object (see printToFile code) -# -sub printToFileHandle -{ - my ($self, $FH) = @_; - my $pr = new XML::DOM::PrintToFileHandle ($FH); - $self->print ($pr); -} - -# -# Used by AttDef::setDefault to convert unexpanded default attribute value -# -sub expandEntityRefs -{ - my ($self, $str) = @_; - my $doctype = $self->[_Doc]->getDoctype; - - $str =~ s/&($XML::RegExp::Name|(#([0-9]+)|#x([0-9a-fA-F]+)));/ - defined($2) ? XML::DOM::XmlUtf8Encode ($3 || hex ($4)) - : expandEntityRef ($1, $doctype)/ego; - $str; -} - -sub expandEntityRef -{ - my ($entity, $doctype) = @_; - - my $expanded = $XML::DOM::DefaultEntities{$entity}; - return $expanded if defined $expanded; - - $expanded = $doctype->getEntity ($entity); - return $expanded->getValue if (defined $expanded); - -#?? is this an error? - croak "Could not expand entity reference of [$entity]\n"; -# return "&$entity;"; # entity not found -} - -sub isHidden -{ - $_[0]->[_Hidden]; -} - -###################################################################### -package XML::DOM::Attr; -###################################################################### - -use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; - -BEGIN -{ - import XML::DOM::Node qw( :DEFAULT :Fields ); - XML::DOM::def_fields ("Name Specified", "XML::DOM::Node"); -} - -use XML::DOM::DOMException; -use Carp; - -sub new -{ - my ($class, $doc, $name, $value, $specified) = @_; - - if ($XML::DOM::SafeMode) - { - croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR, - "bad Attr name [$name]") - unless XML::DOM::isValidName ($name); - } - - my $self = bless [], $class; - - $self->[_Doc] = $doc; - $self->[_C] = new XML::DOM::NodeList; - $self->[_Name] = $name; - - if (defined $value) - { - $self->setValue ($value); - $self->[_Specified] = (defined $specified) ? $specified : 1; - } - else - { - $self->[_Specified] = 0; - } - $self; -} - -sub getNodeType -{ - ATTRIBUTE_NODE; -} - -sub isSpecified -{ - $_[0]->[_Specified]; -} - -sub getName -{ - $_[0]->[_Name]; -} - -sub getValue -{ - my $self = shift; - my $value = ""; - - for my $kid (@{$self->[_C]}) - { - $value .= $kid->getData; - } - $value; -} - -sub setValue -{ - my ($self, $value) = @_; - - # REC 1147 - $self->removeChildNodes; - $self->appendChild ($self->[_Doc]->createTextNode ($value)); - $self->[_Specified] = 1; -} - -sub getNodeName -{ - $_[0]->getName; -} - -sub getNodeValue -{ - $_[0]->getValue; -} - -sub setNodeValue -{ - $_[0]->setValue ($_[1]); -} - -sub cloneNode -{ - my ($self) = @_; # parameter deep is ignored - - my $node = $self->[_Doc]->createAttribute ($self->getName); - $node->[_Specified] = $self->[_Specified]; - $node->[_ReadOnly] = 1 if $self->[_ReadOnly]; - - $node->cloneChildren ($self, 1); - $node; -} - -#------------------------------------------------------------ -# Extra method implementations -# - -sub isReadOnly -{ - # ReadOnly property is set if it's part of a AttDef - ! $XML::DOM::IgnoreReadOnly && defined ($_[0]->[_ReadOnly]); -} - -sub print -{ - my ($self, $FILE) = @_; - - my $name = $self->[_Name]; - - $FILE->print ("$name=\""); - for my $kid (@{$self->[_C]}) - { - if ($kid->getNodeType == TEXT_NODE) - { - $FILE->print (XML::DOM::encodeAttrValue ($kid->getData)); - } - else # ENTITY_REFERENCE_NODE - { - $kid->print ($FILE); - } - } - $FILE->print ("\""); -} - -sub rejectChild -{ - my $t = $_[1]->getNodeType; - - $t != TEXT_NODE - && $t != ENTITY_REFERENCE_NODE; -} - -###################################################################### -package XML::DOM::ProcessingInstruction; -###################################################################### - -use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; -BEGIN -{ - import XML::DOM::Node qw( :DEFAULT :Fields ); - XML::DOM::def_fields ("Target Data", "XML::DOM::Node"); -} - -use XML::DOM::DOMException; -use Carp; - -sub new -{ - my ($class, $doc, $target, $data, $hidden) = @_; - - croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR, - "bad ProcessingInstruction Target [$target]") - unless (XML::DOM::isValidName ($target) && $target !~ /^xml$/io); - - my $self = bless [], $class; - - $self->[_Doc] = $doc; - $self->[_Target] = $target; - $self->[_Data] = $data; - $self->[_Hidden] = $hidden; - $self; -} - -sub getNodeType -{ - PROCESSING_INSTRUCTION_NODE; -} - -sub getTarget -{ - $_[0]->[_Target]; -} - -sub getData -{ - $_[0]->[_Data]; -} - -sub setData -{ - my ($self, $data) = @_; - - croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, - "node is ReadOnly") - if $self->isReadOnly; - - $self->[_Data] = $data; -} - -sub getNodeName -{ - $_[0]->[_Target]; -} - -# -# Same as getData -# -sub getNodeValue -{ - $_[0]->[_Data]; -} - -sub setNodeValue -{ - $_[0]->setData ($_[1]); -} - -sub cloneNode -{ - my $self = shift; - $self->[_Doc]->createProcessingInstruction ($self->getTarget, - $self->getData, - $self->isHidden); -} - -#------------------------------------------------------------ -# Extra method implementations - -sub isReadOnly -{ - return 0 if $XML::DOM::IgnoreReadOnly; - - my $pa = $_[0]->[_Parent]; - defined ($pa) ? $pa->isReadOnly : 0; -} - -sub print -{ - my ($self, $FILE) = @_; - - $FILE->print ("print ($self->[_Target]); - $FILE->print (" "); - $FILE->print (XML::DOM::encodeProcessingInstruction ($self->[_Data])); - $FILE->print ("?>"); -} - -###################################################################### -package XML::DOM::Notation; -###################################################################### -use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; - -BEGIN -{ - import XML::DOM::Node qw( :DEFAULT :Fields ); - XML::DOM::def_fields ("Name Base SysId PubId", "XML::DOM::Node"); -} - -use XML::DOM::DOMException; -use Carp; - -sub new -{ - my ($class, $doc, $name, $base, $sysId, $pubId, $hidden) = @_; - - croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR, - "bad Notation Name [$name]") - unless XML::DOM::isValidName ($name); - - my $self = bless [], $class; - - $self->[_Doc] = $doc; - $self->[_Name] = $name; - $self->[_Base] = $base; - $self->[_SysId] = $sysId; - $self->[_PubId] = $pubId; - $self->[_Hidden] = $hidden; - $self; -} - -sub getNodeType -{ - NOTATION_NODE; -} - -sub getPubId -{ - $_[0]->[_PubId]; -} - -sub setPubId -{ - $_[0]->[_PubId] = $_[1]; -} - -sub getSysId -{ - $_[0]->[_SysId]; -} - -sub setSysId -{ - $_[0]->[_SysId] = $_[1]; -} - -sub getName -{ - $_[0]->[_Name]; -} - -sub setName -{ - $_[0]->[_Name] = $_[1]; -} - -sub getBase -{ - $_[0]->[_Base]; -} - -sub getNodeName -{ - $_[0]->[_Name]; -} - -sub print -{ - my ($self, $FILE) = @_; - - my $name = $self->[_Name]; - my $sysId = $self->[_SysId]; - my $pubId = $self->[_PubId]; - - $FILE->print ("print (" PUBLIC \"$pubId\""); - } - if (defined $sysId) - { - $FILE->print (" SYSTEM \"$sysId\""); - } - $FILE->print (">"); -} - -sub cloneNode -{ - my ($self) = @_; - $self->[_Doc]->createNotation ($self->[_Name], $self->[_Base], - $self->[_SysId], $self->[_PubId], - $self->[_Hidden]); -} - -sub to_expat -{ - my ($self, $iter) = @_; - $iter->Notation ($self->getName, $self->getBase, - $self->getSysId, $self->getPubId); -} - -sub _to_sax -{ - my ($self, $doch, $dtdh, $enth) = @_; - $dtdh->notation_decl ( { Name => $self->getName, - Base => $self->getBase, - SystemId => $self->getSysId, - PublicId => $self->getPubId }); -} - -###################################################################### -package XML::DOM::Entity; -###################################################################### -use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; - -BEGIN -{ - import XML::DOM::Node qw( :DEFAULT :Fields ); - XML::DOM::def_fields ("NotationName Parameter Value Ndata SysId PubId", "XML::DOM::Node"); -} - -use XML::DOM::DOMException; -use Carp; - -sub new -{ - my ($class, $doc, $notationName, $value, $sysId, $pubId, $ndata, $isParam, $hidden) = @_; - - croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR, - "bad Entity Name [$notationName]") - unless XML::DOM::isValidName ($notationName); - - my $self = bless [], $class; - - $self->[_Doc] = $doc; - $self->[_NotationName] = $notationName; - $self->[_Parameter] = $isParam; - $self->[_Value] = $value; - $self->[_Ndata] = $ndata; - $self->[_SysId] = $sysId; - $self->[_PubId] = $pubId; - $self->[_Hidden] = $hidden; - $self; -#?? maybe Value should be a Text node -} - -sub getNodeType -{ - ENTITY_NODE; -} - -sub getPubId -{ - $_[0]->[_PubId]; -} - -sub getSysId -{ - $_[0]->[_SysId]; -} - -# Dom Spec says: -# For unparsed entities, the name of the notation for the -# entity. For parsed entities, this is null. - -#?? do we have unparsed entities? -sub getNotationName -{ - $_[0]->[_NotationName]; -} - -sub getNodeName -{ - $_[0]->[_NotationName]; -} - -sub cloneNode -{ - my $self = shift; - $self->[_Doc]->createEntity ($self->[_NotationName], $self->[_Value], - $self->[_SysId], $self->[_PubId], - $self->[_Ndata], $self->[_Parameter], $self->[_Hidden]); -} - -sub rejectChild -{ - return 1; -#?? if value is split over subnodes, recode this section -# also add: C => new XML::DOM::NodeList, - - my $t = $_[1]; - - return $t == TEXT_NODE - || $t == ENTITY_REFERENCE_NODE - || $t == PROCESSING_INSTRUCTION_NODE - || $t == COMMENT_NODE - || $t == CDATA_SECTION_NODE - || $t == ELEMENT_NODE; -} - -sub getValue -{ - $_[0]->[_Value]; -} - -sub isParameterEntity -{ - $_[0]->[_Parameter]; -} - -sub getNdata -{ - $_[0]->[_Ndata]; -} - -sub print -{ - my ($self, $FILE) = @_; - - my $name = $self->[_NotationName]; - - my $par = $self->isParameterEntity ? "% " : ""; - - $FILE->print ("[_Value]; - my $sysId = $self->[_SysId]; - my $pubId = $self->[_PubId]; - my $ndata = $self->[_Ndata]; - - if (defined $value) - { -#?? Not sure what to do if it contains both single and double quote - $value = ($value =~ /\"/) ? "'$value'" : "\"$value\""; - $FILE->print (" $value"); - } - if (defined $pubId) - { - $FILE->print (" PUBLIC \"$pubId\""); - } - elsif (defined $sysId) - { - $FILE->print (" SYSTEM"); - } - - if (defined $sysId) - { - $FILE->print (" \"$sysId\""); - } - $FILE->print (" NDATA $ndata") if defined $ndata; - $FILE->print (">"); -} - -sub to_expat -{ - my ($self, $iter) = @_; - my $name = ($self->isParameterEntity ? '%' : "") . $self->getNotationName; - $iter->Entity ($name, - $self->getValue, $self->getSysId, $self->getPubId, - $self->getNdata); -} - -sub _to_sax -{ - my ($self, $doch, $dtdh, $enth) = @_; - my $name = ($self->isParameterEntity ? '%' : "") . $self->getNotationName; - $dtdh->entity_decl ( { Name => $name, - Value => $self->getValue, - SystemId => $self->getSysId, - PublicId => $self->getPubId, - Notation => $self->getNdata } ); -} - -###################################################################### -package XML::DOM::EntityReference; -###################################################################### -use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; - -BEGIN -{ - import XML::DOM::Node qw( :DEFAULT :Fields ); - XML::DOM::def_fields ("EntityName Parameter", "XML::DOM::Node"); -} - -use XML::DOM::DOMException; -use Carp; - -sub new -{ - my ($class, $doc, $name, $parameter) = @_; - - croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR, - "bad Entity Name [$name] in EntityReference") - unless XML::DOM::isValidName ($name); - - my $self = bless [], $class; - - $self->[_Doc] = $doc; - $self->[_EntityName] = $name; - $self->[_Parameter] = ($parameter || 0); - $self; -} - -sub getNodeType -{ - ENTITY_REFERENCE_NODE; -} - -sub getNodeName -{ - $_[0]->[_EntityName]; -} - -#------------------------------------------------------------ -# Extra method implementations - -sub getEntityName -{ - $_[0]->[_EntityName]; -} - -sub isParameterEntity -{ - $_[0]->[_Parameter]; -} - -sub getData -{ - my $self = shift; - my $name = $self->[_EntityName]; - my $parameter = $self->[_Parameter]; - - my $data = $self->[_Doc]->expandEntity ($name, $parameter); - - unless (defined $data) - { -#?? this is probably an error - my $pc = $parameter ? "%" : "&"; - $data = "$pc$name;"; - } - $data; -} - -sub print -{ - my ($self, $FILE) = @_; - - my $name = $self->[_EntityName]; - -#?? or do we expand the entities? - - my $pc = $self->[_Parameter] ? "%" : "&"; - $FILE->print ("$pc$name;"); -} - -# Dom Spec says: -# [...] but if such an Entity exists, then -# the child list of the EntityReference node is the same as that of the -# Entity node. -# -# The resolution of the children of the EntityReference (the replacement -# value of the referenced Entity) may be lazily evaluated; actions by the -# user (such as calling the childNodes method on the EntityReference -# node) are assumed to trigger the evaluation. -sub getChildNodes -{ - my $self = shift; - my $entity = $self->[_Doc]->getEntity ($self->[_EntityName]); - defined ($entity) ? $entity->getChildNodes : new XML::DOM::NodeList; -} - -sub cloneNode -{ - my $self = shift; - $self->[_Doc]->createEntityReference ($self->[_EntityName], - $self->[_Parameter]); -} - -sub to_expat -{ - my ($self, $iter) = @_; - $iter->EntityRef ($self->getEntityName, $self->isParameterEntity); -} - -sub _to_sax -{ - my ($self, $doch, $dtdh, $enth) = @_; - my @par = $self->isParameterEntity ? (Parameter => 1) : (); -#?? not supported by PerlSAX: $self->isParameterEntity - - $doch->entity_reference ( { Name => $self->getEntityName, @par } ); -} - -# NOTE: an EntityReference can't really have children, so rejectChild -# is not reimplemented (i.e. it always returns 0.) - -###################################################################### -package XML::DOM::AttDef; -###################################################################### -use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; - -BEGIN -{ - import XML::DOM::Node qw( :DEFAULT :Fields ); - XML::DOM::def_fields ("Name Type Fixed Default Required Implied Quote", "XML::DOM::Node"); -} - -use XML::DOM::DOMException; -use Carp; - -#------------------------------------------------------------ -# Extra method implementations - -# AttDef is not part of DOM Spec -sub new -{ - my ($class, $doc, $name, $attrType, $default, $fixed, $hidden) = @_; - - croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR, - "bad Attr name in AttDef [$name]") - unless XML::DOM::isValidName ($name); - - my $self = bless [], $class; - - $self->[_Doc] = $doc; - $self->[_Name] = $name; - $self->[_Type] = $attrType; - - if (defined $default) - { - if ($default eq "#REQUIRED") - { - $self->[_Required] = 1; - } - elsif ($default eq "#IMPLIED") - { - $self->[_Implied] = 1; - } - else - { - # strip off quotes - see Attlist handler in XML::Parser - $default =~ m#^(["'])(.*)['"]$#; - - $self->[_Quote] = $1; # keep track of the quote character - $self->[_Default] = $self->setDefault ($2); - -#?? should default value be decoded - what if it contains e.g. "&" - } - } - $self->[_Fixed] = $fixed if defined $fixed; - $self->[_Hidden] = $hidden if defined $hidden; - - $self; -} - -sub getNodeType -{ - ATT_DEF_NODE; -} - -sub getName -{ - $_[0]->[_Name]; -} - -# So it can be added to a NamedNodeMap -sub getNodeName -{ - $_[0]->[_Name]; -} - -sub getType -{ - $_[0]->[_Type]; -} - -sub setType -{ - $_[0]->[_Type] = $_[1]; -} - -sub getDefault -{ - $_[0]->[_Default]; -} - -sub setDefault -{ - my ($self, $value) = @_; - - # specified=0, it's the default ! - my $attr = $self->[_Doc]->createAttribute ($self->[_Name], undef, 0); - $attr->[_ReadOnly] = 1; - -#?? this should be split over Text and EntityReference nodes, just like other -# Attr nodes - just expand the text for now - $value = $self->expandEntityRefs ($value); - $attr->addText ($value); -#?? reimplement in NoExpand mode! - - $attr; -} - -sub isFixed -{ - $_[0]->[_Fixed] || 0; -} - -sub isRequired -{ - $_[0]->[_Required] || 0; -} - -sub isImplied -{ - $_[0]->[_Implied] || 0; -} - -sub print -{ - my ($self, $FILE) = @_; - - my $name = $self->[_Name]; - my $type = $self->[_Type]; - my $fixed = $self->[_Fixed]; - my $default = $self->[_Default]; - -# $FILE->print ("$name $type"); - # replaced line above with the two lines below - # seems to be a bug in perl 5.6.0 that causes - # test 3 of dom_jp_attr.t to fail? - $FILE->print ($name); - $FILE->print (" $type"); - - $FILE->print (" #FIXED") if defined $fixed; - - if ($self->[_Required]) - { - $FILE->print (" #REQUIRED"); - } - elsif ($self->[_Implied]) - { - $FILE->print (" #IMPLIED"); - } - elsif (defined ($default)) - { - my $quote = $self->[_Quote]; - $FILE->print (" $quote"); - for my $kid (@{$default->[_C]}) - { - $kid->print ($FILE); - } - $FILE->print ($quote); - } -} - -sub getDefaultString -{ - my $self = shift; - my $default; - - if ($self->[_Required]) - { - return "#REQUIRED"; - } - elsif ($self->[_Implied]) - { - return "#IMPLIED"; - } - elsif (defined ($default = $self->[_Default])) - { - my $quote = $self->[_Quote]; - $default = $default->toString; - return "$quote$default$quote"; - } - undef; -} - -sub cloneNode -{ - my $self = shift; - my $node = new XML::DOM::AttDef ($self->[_Doc], $self->[_Name], $self->[_Type], - undef, $self->[_Fixed]); - - $node->[_Required] = 1 if $self->[_Required]; - $node->[_Implied] = 1 if $self->[_Implied]; - $node->[_Fixed] = $self->[_Fixed] if defined $self->[_Fixed]; - $node->[_Hidden] = $self->[_Hidden] if defined $self->[_Hidden]; - - if (defined $self->[_Default]) - { - $node->[_Default] = $self->[_Default]->cloneNode(1); - } - $node->[_Quote] = $self->[_Quote]; - - $node; -} - -sub setOwnerDocument -{ - my ($self, $doc) = @_; - $self->SUPER::setOwnerDocument ($doc); - - if (defined $self->[_Default]) - { - $self->[_Default]->setOwnerDocument ($doc); - } -} - -###################################################################### -package XML::DOM::AttlistDecl; -###################################################################### -use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; - -BEGIN -{ - import XML::DOM::Node qw( :DEFAULT :Fields ); - import XML::DOM::AttDef qw{ :Fields }; - - XML::DOM::def_fields ("ElementName", "XML::DOM::Node"); -} - -use XML::DOM::DOMException; -use Carp; - -#------------------------------------------------------------ -# Extra method implementations - -# AttlistDecl is not part of the DOM Spec -sub new -{ - my ($class, $doc, $name) = @_; - - croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR, - "bad Element TagName [$name] in AttlistDecl") - unless XML::DOM::isValidName ($name); - - my $self = bless [], $class; - - $self->[_Doc] = $doc; - $self->[_C] = new XML::DOM::NodeList; - $self->[_ReadOnly] = 1; - $self->[_ElementName] = $name; - - $self->[_A] = new XML::DOM::NamedNodeMap (Doc => $doc, - ReadOnly => 1, - Parent => $self); - - $self; -} - -sub getNodeType -{ - ATTLIST_DECL_NODE; -} - -sub getName -{ - $_[0]->[_ElementName]; -} - -sub getNodeName -{ - $_[0]->[_ElementName]; -} - -sub getAttDef -{ - my ($self, $attrName) = @_; - $self->[_A]->getNamedItem ($attrName); -} - -sub addAttDef -{ - my ($self, $attrName, $type, $default, $fixed, $hidden) = @_; - my $node = $self->getAttDef ($attrName); - - if (defined $node) - { - # data will be ignored if already defined - my $elemName = $self->getName; - XML::DOM::warning ("multiple definitions of attribute $attrName for element $elemName, only first one is recognized"); - } - else - { - $node = new XML::DOM::AttDef ($self->[_Doc], $attrName, $type, - $default, $fixed, $hidden); - $self->[_A]->setNamedItem ($node); - } - $node; -} - -sub getDefaultAttrValue -{ - my ($self, $attr) = @_; - my $attrNode = $self->getAttDef ($attr); - (defined $attrNode) ? $attrNode->getDefault : undef; -} - -sub cloneNode -{ - my ($self, $deep) = @_; - my $node = $self->[_Doc]->createAttlistDecl ($self->[_ElementName]); - - $node->[_A] = $self->[_A]->cloneNode ($deep); - $node; -} - -sub setOwnerDocument -{ - my ($self, $doc) = @_; - $self->SUPER::setOwnerDocument ($doc); - - $self->[_A]->setOwnerDocument ($doc); -} - -sub print -{ - my ($self, $FILE) = @_; - - my $name = $self->getName; - my @attlist = @{$self->[_A]->getValues}; - - my $hidden = 1; - for my $att (@attlist) - { - unless ($att->[_Hidden]) - { - $hidden = 0; - last; - } - } - - unless ($hidden) - { - $FILE->print ("print (" "); - $attlist[0]->print ($FILE); - } - else - { - for my $attr (@attlist) - { - next if $attr->[_Hidden]; - - $FILE->print ("\x0A "); - $attr->print ($FILE); - } - } - $FILE->print (">"); - } -} - -sub to_expat -{ - my ($self, $iter) = @_; - my $tag = $self->getName; - for my $a ($self->[_A]->getValues) - { - my $default = $a->isImplied ? '#IMPLIED' : - ($a->isRequired ? '#REQUIRED' : - ($a->[_Quote] . $a->getDefault->getValue . $a->[_Quote])); - - $iter->Attlist ($tag, $a->getName, $a->getType, $default, $a->isFixed); - } -} - -sub _to_sax -{ - my ($self, $doch, $dtdh, $enth) = @_; - my $tag = $self->getName; - for my $a ($self->[_A]->getValues) - { - my $default = $a->isImplied ? '#IMPLIED' : - ($a->isRequired ? '#REQUIRED' : - ($a->[_Quote] . $a->getDefault->getValue . $a->[_Quote])); - - $dtdh->attlist_decl ({ ElementName => $tag, - AttributeName => $a->getName, - Type => $a->[_Type], - Default => $default, - Fixed => $a->isFixed }); - } -} - -###################################################################### -package XML::DOM::ElementDecl; -###################################################################### -use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; - -BEGIN -{ - import XML::DOM::Node qw( :DEFAULT :Fields ); - XML::DOM::def_fields ("Name Model", "XML::DOM::Node"); -} - -use XML::DOM::DOMException; -use Carp; - - -#------------------------------------------------------------ -# Extra method implementations - -# ElementDecl is not part of the DOM Spec -sub new -{ - my ($class, $doc, $name, $model, $hidden) = @_; - - croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR, - "bad Element TagName [$name] in ElementDecl") - unless XML::DOM::isValidName ($name); - - my $self = bless [], $class; - - $self->[_Doc] = $doc; - $self->[_Name] = $name; - $self->[_ReadOnly] = 1; - $self->[_Model] = $model; - $self->[_Hidden] = $hidden; - $self; -} - -sub getNodeType -{ - ELEMENT_DECL_NODE; -} - -sub getName -{ - $_[0]->[_Name]; -} - -sub getNodeName -{ - $_[0]->[_Name]; -} - -sub getModel -{ - $_[0]->[_Model]; -} - -sub setModel -{ - my ($self, $model) = @_; - - $self->[_Model] = $model; -} - -sub print -{ - my ($self, $FILE) = @_; - - my $name = $self->[_Name]; - my $model = $self->[_Model]; - - $FILE->print ("") - unless $self->[_Hidden]; -} - -sub cloneNode -{ - my $self = shift; - $self->[_Doc]->createElementDecl ($self->[_Name], $self->[_Model], - $self->[_Hidden]); -} - -sub to_expat -{ -#?? add support for Hidden?? (allover, also in _to_sax!!) - - my ($self, $iter) = @_; - $iter->Element ($self->getName, $self->getModel); -} - -sub _to_sax -{ - my ($self, $doch, $dtdh, $enth) = @_; - $dtdh->element_decl ( { Name => $self->getName, - Model => $self->getModel } ); -} - -###################################################################### -package XML::DOM::Element; -###################################################################### -use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; - -BEGIN -{ - import XML::DOM::Node qw( :DEFAULT :Fields ); - XML::DOM::def_fields ("TagName", "XML::DOM::Node"); -} - -use XML::DOM::DOMException; -use XML::DOM::NamedNodeMap; -use Carp; - -sub new -{ - my ($class, $doc, $tagName) = @_; - - if ($XML::DOM::SafeMode) - { - croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR, - "bad Element TagName [$tagName]") - unless XML::DOM::isValidName ($tagName); - } - - my $self = bless [], $class; - - $self->[_Doc] = $doc; - $self->[_C] = new XML::DOM::NodeList; - $self->[_TagName] = $tagName; - -# Now we're creating the NamedNodeMap only when needed (REC 2313 => 1147) -# $self->[_A] = new XML::DOM::NamedNodeMap (Doc => $doc, -# Parent => $self); - - $self; -} - -sub getNodeType -{ - ELEMENT_NODE; -} - -sub getTagName -{ - $_[0]->[_TagName]; -} - -sub getNodeName -{ - $_[0]->[_TagName]; -} - -sub getAttributeNode -{ - my ($self, $name) = @_; - return undef unless defined $self->[_A]; - - $self->getAttributes->{$name}; -} - -sub getAttribute -{ - my ($self, $name) = @_; - my $attr = $self->getAttributeNode ($name); - (defined $attr) ? $attr->getValue : ""; -} - -sub setAttribute -{ - my ($self, $name, $val) = @_; - - croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR, - "bad Attr Name [$name]") - unless XML::DOM::isValidName ($name); - - croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, - "node is ReadOnly") - if $self->isReadOnly; - - my $node = $self->getAttributes->{$name}; - if (defined $node) - { - $node->setValue ($val); - } - else - { - $node = $self->[_Doc]->createAttribute ($name, $val); - $self->[_A]->setNamedItem ($node); - } -} - -sub setAttributeNode -{ - my ($self, $node) = @_; - my $attr = $self->getAttributes; - my $name = $node->getNodeName; - - # REC 1147 - if ($XML::DOM::SafeMode) - { - croak new XML::DOM::DOMException (WRONG_DOCUMENT_ERR, - "nodes belong to different documents") - if $self->[_Doc] != $node->[_Doc]; - - croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, - "node is ReadOnly") - if $self->isReadOnly; - - my $attrParent = $node->[_UsedIn]; - croak new XML::DOM::DOMException (INUSE_ATTRIBUTE_ERR, - "Attr is already used by another Element") - if (defined ($attrParent) && $attrParent != $attr); - } - - my $other = $attr->{$name}; - $attr->removeNamedItem ($name) if defined $other; - - $attr->setNamedItem ($node); - - $other; -} - -sub removeAttributeNode -{ - my ($self, $node) = @_; - - croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, - "node is ReadOnly") - if $self->isReadOnly; - - my $attr = $self->[_A]; - unless (defined $attr) - { - croak new XML::DOM::DOMException (NOT_FOUND_ERR); - return undef; - } - - my $name = $node->getNodeName; - my $attrNode = $attr->getNamedItem ($name); - -#?? should it croak if it's the default value? - croak new XML::DOM::DOMException (NOT_FOUND_ERR) - unless $node == $attrNode; - - # Not removing anything if it's the default value already - return undef unless $node->isSpecified; - - $attr->removeNamedItem ($name); - - # Substitute with default value if it's defined - my $default = $self->getDefaultAttrValue ($name); - if (defined $default) - { - local $XML::DOM::IgnoreReadOnly = 1; - - $default = $default->cloneNode (1); - $attr->setNamedItem ($default); - } - $node; -} - -sub removeAttribute -{ - my ($self, $name) = @_; - my $attr = $self->[_A]; - unless (defined $attr) - { - croak new XML::DOM::DOMException (NOT_FOUND_ERR); - return; - } - - my $node = $attr->getNamedItem ($name); - if (defined $node) - { -#?? could use dispose() to remove circular references for gc, but what if -#?? somebody is referencing it? - $self->removeAttributeNode ($node); - } -} - -sub cloneNode -{ - my ($self, $deep) = @_; - my $node = $self->[_Doc]->createElement ($self->getTagName); - - # Always clone the Attr nodes, even if $deep == 0 - if (defined $self->[_A]) - { - $node->[_A] = $self->[_A]->cloneNode (1); # deep=1 - $node->[_A]->setParentNode ($node); - } - - $node->cloneChildren ($self, $deep); - $node; -} - -sub getAttributes -{ - $_[0]->[_A] ||= XML::DOM::NamedNodeMap->new (Doc => $_[0]->[_Doc], - Parent => $_[0]); -} - -#------------------------------------------------------------ -# Extra method implementations - -# Added for convenience -sub setTagName -{ - my ($self, $tagName) = @_; - - croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR, - "bad Element TagName [$tagName]") - unless XML::DOM::isValidName ($tagName); - - $self->[_TagName] = $tagName; -} - -sub isReadOnly -{ - 0; -} - -# Added for optimization. -sub isElementNode -{ - 1; -} - -sub rejectChild -{ - my $t = $_[1]->getNodeType; - - $t != TEXT_NODE - && $t != ENTITY_REFERENCE_NODE - && $t != PROCESSING_INSTRUCTION_NODE - && $t != COMMENT_NODE - && $t != CDATA_SECTION_NODE - && $t != ELEMENT_NODE; -} - -sub getDefaultAttrValue -{ - my ($self, $attr) = @_; - $self->[_Doc]->getDefaultAttrValue ($self->[_TagName], $attr); -} - -sub dispose -{ - my $self = shift; - - $self->[_A]->dispose if defined $self->[_A]; - $self->SUPER::dispose; -} - -sub setOwnerDocument -{ - my ($self, $doc) = @_; - $self->SUPER::setOwnerDocument ($doc); - - $self->[_A]->setOwnerDocument ($doc) if defined $self->[_A]; -} - -sub print -{ - my ($self, $FILE) = @_; - - my $name = $self->[_TagName]; - - $FILE->print ("<$name"); - - if (defined $self->[_A]) - { - for my $att (@{$self->[_A]->getValues}) - { - # skip un-specified (default) Attr nodes - if ($att->isSpecified) - { - $FILE->print (" "); - $att->print ($FILE); - } - } - } - - my @kids = @{$self->[_C]}; - if (@kids > 0) - { - $FILE->print (">"); - for my $kid (@kids) - { - $kid->print ($FILE); - } - $FILE->print (""); - } - else - { - my $style = &$XML::DOM::TagStyle ($name, $self); - if ($style == 0) - { - $FILE->print ("/>"); - } - elsif ($style == 1) - { - $FILE->print (">"); - } - else - { - $FILE->print (" />"); - } - } -} - -sub check -{ - my ($self, $checker) = @_; - die "Usage: \$xml_dom_elem->check (\$checker)" unless $checker; - - $checker->InitDomElem; - $self->to_expat ($checker); - $checker->FinalDomElem; -} - -sub to_expat -{ - my ($self, $iter) = @_; - - my $tag = $self->getTagName; - $iter->Start ($tag); - - if (defined $self->[_A]) - { - for my $attr ($self->[_A]->getValues) - { - $iter->Attr ($tag, $attr->getName, $attr->getValue, $attr->isSpecified); - } - } - - $iter->EndAttr; - - for my $kid ($self->getChildNodes) - { - $kid->to_expat ($iter); - } - - $iter->End; -} - -sub _to_sax -{ - my ($self, $doch, $dtdh, $enth) = @_; - - my $tag = $self->getTagName; - - my @attr = (); - my $attrOrder; - my $attrDefaulted; - - if (defined $self->[_A]) - { - my @spec = (); # names of specified attributes - my @unspec = (); # names of defaulted attributes - - for my $attr ($self->[_A]->getValues) - { - my $attrName = $attr->getName; - push @attr, $attrName, $attr->getValue; - if ($attr->isSpecified) - { - push @spec, $attrName; - } - else - { - push @unspec, $attrName; - } - } - $attrOrder = [ @spec, @unspec ]; - $attrDefaulted = @spec; - } - $doch->start_element (defined $attrOrder ? - { Name => $tag, - Attributes => { @attr }, - AttributeOrder => $attrOrder, - Defaulted => $attrDefaulted - } : - { Name => $tag, - Attributes => { @attr } - } - ); - - for my $kid ($self->getChildNodes) - { - $kid->_to_sax ($doch, $dtdh, $enth); - } - - $doch->end_element ( { Name => $tag } ); -} - -###################################################################### -package XML::DOM::CharacterData; -###################################################################### -use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; - -BEGIN -{ - import XML::DOM::Node qw( :DEFAULT :Fields ); - XML::DOM::def_fields ("Data", "XML::DOM::Node"); -} - -use XML::DOM::DOMException; -use Carp; - - -# -# CharacterData nodes should never be created directly, only subclassed! -# -sub new -{ - my ($class, $doc, $data) = @_; - my $self = bless [], $class; - - $self->[_Doc] = $doc; - $self->[_Data] = $data; - $self; -} - -sub appendData -{ - my ($self, $data) = @_; - - if ($XML::DOM::SafeMode) - { - croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, - "node is ReadOnly") - if $self->isReadOnly; - } - $self->[_Data] .= $data; -} - -sub deleteData -{ - my ($self, $offset, $count) = @_; - - croak new XML::DOM::DOMException (INDEX_SIZE_ERR, - "bad offset [$offset]") - if ($offset < 0 || $offset >= length ($self->[_Data])); -#?? DOM Spec says >, but >= makes more sense! - - croak new XML::DOM::DOMException (INDEX_SIZE_ERR, - "negative count [$count]") - if $count < 0; - - croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, - "node is ReadOnly") - if $self->isReadOnly; - - substr ($self->[_Data], $offset, $count) = ""; -} - -sub getData -{ - $_[0]->[_Data]; -} - -sub getLength -{ - length $_[0]->[_Data]; -} - -sub insertData -{ - my ($self, $offset, $data) = @_; - - croak new XML::DOM::DOMException (INDEX_SIZE_ERR, - "bad offset [$offset]") - if ($offset < 0 || $offset >= length ($self->[_Data])); -#?? DOM Spec says >, but >= makes more sense! - - croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, - "node is ReadOnly") - if $self->isReadOnly; - - substr ($self->[_Data], $offset, 0) = $data; -} - -sub replaceData -{ - my ($self, $offset, $count, $data) = @_; - - croak new XML::DOM::DOMException (INDEX_SIZE_ERR, - "bad offset [$offset]") - if ($offset < 0 || $offset >= length ($self->[_Data])); -#?? DOM Spec says >, but >= makes more sense! - - croak new XML::DOM::DOMException (INDEX_SIZE_ERR, - "negative count [$count]") - if $count < 0; - - croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, - "node is ReadOnly") - if $self->isReadOnly; - - substr ($self->[_Data], $offset, $count) = $data; -} - -sub setData -{ - my ($self, $data) = @_; - - croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, - "node is ReadOnly") - if $self->isReadOnly; - - $self->[_Data] = $data; -} - -sub substringData -{ - my ($self, $offset, $count) = @_; - my $data = $self->[_Data]; - - croak new XML::DOM::DOMException (INDEX_SIZE_ERR, - "bad offset [$offset]") - if ($offset < 0 || $offset >= length ($data)); -#?? DOM Spec says >, but >= makes more sense! - - croak new XML::DOM::DOMException (INDEX_SIZE_ERR, - "negative count [$count]") - if $count < 0; - - substr ($data, $offset, $count); -} - -sub getNodeValue -{ - $_[0]->getData; -} - -sub setNodeValue -{ - $_[0]->setData ($_[1]); -} - -###################################################################### -package XML::DOM::CDATASection; -###################################################################### -use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; - -BEGIN -{ - import XML::DOM::CharacterData qw( :DEFAULT :Fields ); - import XML::DOM::Node qw( :DEFAULT :Fields ); - XML::DOM::def_fields ("", "XML::DOM::CharacterData"); -} - -use XML::DOM::DOMException; - -sub getNodeName -{ - "#cdata-section"; -} - -sub getNodeType -{ - CDATA_SECTION_NODE; -} - -sub cloneNode -{ - my $self = shift; - $self->[_Doc]->createCDATASection ($self->getData); -} - -#------------------------------------------------------------ -# Extra method implementations - -sub isReadOnly -{ - 0; -} - -sub print -{ - my ($self, $FILE) = @_; - $FILE->print ("print (XML::DOM::encodeCDATA ($self->getData)); - $FILE->print ("]]>"); -} - -sub to_expat -{ - my ($self, $iter) = @_; - $iter->CData ($self->getData); -} - -sub _to_sax -{ - my ($self, $doch, $dtdh, $enth) = @_; - $doch->start_cdata; - $doch->characters ( { Data => $self->getData } ); - $doch->end_cdata; -} - -###################################################################### -package XML::DOM::Comment; -###################################################################### -use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; - -BEGIN -{ - import XML::DOM::CharacterData qw( :DEFAULT :Fields ); - import XML::DOM::Node qw( :DEFAULT :Fields ); - XML::DOM::def_fields ("", "XML::DOM::CharacterData"); -} - -use XML::DOM::DOMException; -use Carp; - -#?? setData - could check comment for double minus - -sub getNodeType -{ - COMMENT_NODE; -} - -sub getNodeName -{ - "#comment"; -} - -sub cloneNode -{ - my $self = shift; - $self->[_Doc]->createComment ($self->getData); -} - -#------------------------------------------------------------ -# Extra method implementations - -sub isReadOnly -{ - return 0 if $XML::DOM::IgnoreReadOnly; - - my $pa = $_[0]->[_Parent]; - defined ($pa) ? $pa->isReadOnly : 0; -} - -sub print -{ - my ($self, $FILE) = @_; - my $comment = XML::DOM::encodeComment ($self->[_Data]); - - $FILE->print (""); -} - -sub to_expat -{ - my ($self, $iter) = @_; - $iter->Comment ($self->getData); -} - -sub _to_sax -{ - my ($self, $doch, $dtdh, $enth) = @_; - $doch->comment ( { Data => $self->getData }); -} - -###################################################################### -package XML::DOM::Text; -###################################################################### -use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; - -BEGIN -{ - import XML::DOM::CharacterData qw( :DEFAULT :Fields ); - import XML::DOM::Node qw( :DEFAULT :Fields ); - XML::DOM::def_fields ("", "XML::DOM::CharacterData"); -} - -use XML::DOM::DOMException; -use Carp; - -sub getNodeType -{ - TEXT_NODE; -} - -sub getNodeName -{ - "#text"; -} - -sub splitText -{ - my ($self, $offset) = @_; - - my $data = $self->getData; - croak new XML::DOM::DOMException (INDEX_SIZE_ERR, - "bad offset [$offset]") - if ($offset < 0 || $offset >= length ($data)); -#?? DOM Spec says >, but >= makes more sense! - - croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR, - "node is ReadOnly") - if $self->isReadOnly; - - my $rest = substr ($data, $offset); - - $self->setData (substr ($data, 0, $offset)); - my $node = $self->[_Doc]->createTextNode ($rest); - - # insert new node after this node - $self->[_Parent]->insertBefore ($node, $self->getNextSibling); - - $node; -} - -sub cloneNode -{ - my $self = shift; - $self->[_Doc]->createTextNode ($self->getData); -} - -#------------------------------------------------------------ -# Extra method implementations - -sub isReadOnly -{ - 0; -} - -sub print -{ - my ($self, $FILE) = @_; - #$FILE->print (XML::DOM::encodeText ($self->getData, '<&>"')); - # cjg - don't encode " in text nodes - $FILE->print (XML::DOM::encodeText ($self->getData, '<&>')); -} - -sub isTextNode -{ - 1; -} - -sub to_expat -{ - my ($self, $iter) = @_; - $iter->Char ($self->getData); -} - -sub _to_sax -{ - my ($self, $doch, $dtdh, $enth) = @_; - $doch->characters ( { Data => $self->getData } ); -} - -###################################################################### -package XML::DOM::XMLDecl; -###################################################################### -use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; - -BEGIN -{ - import XML::DOM::Node qw( :DEFAULT :Fields ); - XML::DOM::def_fields ("Version Encoding Standalone", "XML::DOM::Node"); -} - -use XML::DOM::DOMException; - - -#------------------------------------------------------------ -# Extra method implementations - -# XMLDecl is not part of the DOM Spec -sub new -{ - my ($class, $doc, $version, $encoding, $standalone) = @_; - - my $self = bless [], $class; - - $self->[_Doc] = $doc; - $self->[_Version] = $version if defined $version; - $self->[_Encoding] = $encoding if defined $encoding; - $self->[_Standalone] = $standalone if defined $standalone; - - $self; -} - -sub setVersion -{ - if (defined $_[1]) - { - $_[0]->[_Version] = $_[1]; - } - else - { - undef $_[0]->[_Version]; # was delete - } -} - -sub getVersion -{ - $_[0]->[_Version]; -} - -sub setEncoding -{ - if (defined $_[1]) - { - $_[0]->[_Encoding] = $_[1]; - } - else - { - undef $_[0]->[_Encoding]; # was delete - } -} - -sub getEncoding -{ - $_[0]->[_Encoding]; -} - -sub setStandalone -{ - if (defined $_[1]) - { - $_[0]->[_Standalone] = $_[1]; - } - else - { - undef $_[0]->[_Standalone]; # was delete - } -} - -sub getStandalone -{ - $_[0]->[_Standalone]; -} - -sub getNodeType -{ - XML_DECL_NODE; -} - -sub cloneNode -{ - my $self = shift; - - new XML::DOM::XMLDecl ($self->[_Doc], $self->[_Version], - $self->[_Encoding], $self->[_Standalone]); -} - -sub print -{ - my ($self, $FILE) = @_; - - my $version = $self->[_Version]; - my $encoding = $self->[_Encoding]; - my $standalone = $self->[_Standalone]; - $standalone = ($standalone ? "yes" : "no") if defined $standalone; - - $FILE->print ("print (" version=\"$version\"") if defined $version; - $FILE->print (" encoding=\"$encoding\"") if defined $encoding; - $FILE->print (" standalone=\"$standalone\"") if defined $standalone; - $FILE->print ("?>"); -} - -sub to_expat -{ - my ($self, $iter) = @_; - $iter->XMLDecl ($self->getVersion, $self->getEncoding, $self->getStandalone); -} - -sub _to_sax -{ - my ($self, $doch, $dtdh, $enth) = @_; - $dtdh->xml_decl ( { Version => $self->getVersion, - Encoding => $self->getEncoding, - Standalone => $self->getStandalone } ); -} - -###################################################################### -package XML::DOM::DocumentFragment; -###################################################################### -use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; - -BEGIN -{ - import XML::DOM::Node qw( :DEFAULT :Fields ); - XML::DOM::def_fields ("", "XML::DOM::Node"); -} - -use XML::DOM::DOMException; - -sub new -{ - my ($class, $doc) = @_; - my $self = bless [], $class; - - $self->[_Doc] = $doc; - $self->[_C] = new XML::DOM::NodeList; - $self; -} - -sub getNodeType -{ - DOCUMENT_FRAGMENT_NODE; -} - -sub getNodeName -{ - "#document-fragment"; -} - -sub cloneNode -{ - my ($self, $deep) = @_; - my $node = $self->[_Doc]->createDocumentFragment; - - $node->cloneChildren ($self, $deep); - $node; -} - -#------------------------------------------------------------ -# Extra method implementations - -sub isReadOnly -{ - 0; -} - -sub print -{ - my ($self, $FILE) = @_; - - for my $node (@{$self->[_C]}) - { - $node->print ($FILE); - } -} - -sub rejectChild -{ - my $t = $_[1]->getNodeType; - - $t != TEXT_NODE - && $t != ENTITY_REFERENCE_NODE - && $t != PROCESSING_INSTRUCTION_NODE - && $t != COMMENT_NODE - && $t != CDATA_SECTION_NODE - && $t != ELEMENT_NODE; -} - -sub isDocumentFragmentNode -{ - 1; -} - -###################################################################### -package XML::DOM::DocumentType; # forward declaration -###################################################################### - -###################################################################### -package XML::DOM::Document; -###################################################################### -use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; - -BEGIN -{ - import XML::DOM::Node qw( :DEFAULT :Fields ); - XML::DOM::def_fields ("Doctype XmlDecl", "XML::DOM::Node"); -} - -use Carp; -use XML::DOM::NodeList; -use XML::DOM::DOMException; - -sub new -{ - my ($class) = @_; - my $self = bless [], $class; - - # keep Doc pointer, even though getOwnerDocument returns undef - $self->[_Doc] = $self; - $self->[_C] = new XML::DOM::NodeList; - $self; -} - -sub getNodeType -{ - DOCUMENT_NODE; -} - -sub getNodeName -{ - "#document"; -} - -#?? not sure about keeping a fixed order of these nodes.... -sub getDoctype -{ - $_[0]->[_Doctype]; -} - -sub getDocumentElement -{ - my ($self) = @_; - for my $kid (@{$self->[_C]}) - { - return $kid if $kid->isElementNode; - } - undef; -} - -sub getOwnerDocument -{ - undef; -} - -sub getImplementation -{ - $XML::DOM::DOMImplementation::Singleton; -} - -# -# Added extra parameters ($val, $specified) that are passed straight to the -# Attr constructor -# -sub createAttribute -{ - new XML::DOM::Attr (@_); -} - -sub createCDATASection -{ - new XML::DOM::CDATASection (@_); -} - -sub createComment -{ - new XML::DOM::Comment (@_); - -} - -sub createElement -{ - new XML::DOM::Element (@_); -} - -sub createTextNode -{ - new XML::DOM::Text (@_); -} - -sub createProcessingInstruction -{ - new XML::DOM::ProcessingInstruction (@_); -} - -sub createEntityReference -{ - new XML::DOM::EntityReference (@_); -} - -sub createDocumentFragment -{ - new XML::DOM::DocumentFragment (@_); -} - -sub createDocumentType -{ - new XML::DOM::DocumentType (@_); -} - -sub cloneNode -{ - my ($self, $deep) = @_; - my $node = new XML::DOM::Document; - - $node->cloneChildren ($self, $deep); - - my $xmlDecl = $self->[_XmlDecl]; - $node->[_XmlDecl] = $xmlDecl->cloneNode ($deep) if defined $xmlDecl; - - $node; -} - -sub appendChild -{ - my ($self, $node) = @_; - - # Extra check: make sure we don't end up with more than one Element. - # Don't worry about multiple DocType nodes, because DocumentFragment - # can't contain DocType nodes. - - my @nodes = ($node); - @nodes = @{$node->[_C]} - if $node->getNodeType == DOCUMENT_FRAGMENT_NODE; - - my $elem = 0; - for my $n (@nodes) - { - $elem++ if $n->isElementNode; - } - - if ($elem > 0 && defined ($self->getDocumentElement)) - { - croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR, - "document can have only one Element"); - } - $self->SUPER::appendChild ($node); -} - -sub insertBefore -{ - my ($self, $node, $refNode) = @_; - - # Extra check: make sure sure we don't end up with more than 1 Elements. - # Don't worry about multiple DocType nodes, because DocumentFragment - # can't contain DocType nodes. - - my @nodes = ($node); - @nodes = @{$node->[_C]} - if $node->getNodeType == DOCUMENT_FRAGMENT_NODE; - - my $elem = 0; - for my $n (@nodes) - { - $elem++ if $n->isElementNode; - } - - if ($elem > 0 && defined ($self->getDocumentElement)) - { - croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR, - "document can have only one Element"); - } - $self->SUPER::insertBefore ($node, $refNode); -} - -sub replaceChild -{ - my ($self, $node, $refNode) = @_; - - # Extra check: make sure sure we don't end up with more than 1 Elements. - # Don't worry about multiple DocType nodes, because DocumentFragment - # can't contain DocType nodes. - - my @nodes = ($node); - @nodes = @{$node->[_C]} - if $node->getNodeType == DOCUMENT_FRAGMENT_NODE; - - my $elem = 0; - $elem-- if $refNode->isElementNode; - - for my $n (@nodes) - { - $elem++ if $n->isElementNode; - } - - if ($elem > 0 && defined ($self->getDocumentElement)) - { - croak new XML::DOM::DOMException (HIERARCHY_REQUEST_ERR, - "document can have only one Element"); - } - $self->SUPER::replaceChild ($node, $refNode); -} - -#------------------------------------------------------------ -# Extra method implementations - -sub isReadOnly -{ - 0; -} - -sub print -{ - my ($self, $FILE) = @_; - - my $xmlDecl = $self->getXMLDecl; - if (defined $xmlDecl) - { - $xmlDecl->print ($FILE); - $FILE->print ("\x0A"); - } - - for my $node (@{$self->[_C]}) - { - $node->print ($FILE); - $FILE->print ("\x0A"); - } -} - -sub setDoctype -{ - my ($self, $doctype) = @_; - my $oldDoctype = $self->[_Doctype]; - if (defined $oldDoctype) - { - $self->replaceChild ($doctype, $oldDoctype); - } - else - { -#?? before root element, but after XmlDecl ! - $self->appendChild ($doctype); - } - $_[0]->[_Doctype] = $_[1]; -} - -sub removeDoctype -{ - my $self = shift; - my $doctype = $self->removeChild ($self->[_Doctype]); - - undef $self->[_Doctype]; # was delete - $doctype; -} - -sub rejectChild -{ - my $t = $_[1]->getNodeType; - $t != ELEMENT_NODE - && $t != PROCESSING_INSTRUCTION_NODE - && $t != COMMENT_NODE - && $t != DOCUMENT_TYPE_NODE; -} - -sub expandEntity -{ - my ($self, $ent, $param) = @_; - my $doctype = $self->getDoctype; - - (defined $doctype) ? $doctype->expandEntity ($ent, $param) : undef; -} - -sub getDefaultAttrValue -{ - my ($self, $elem, $attr) = @_; - - my $doctype = $self->getDoctype; - - (defined $doctype) ? $doctype->getDefaultAttrValue ($elem, $attr) : undef; -} - -sub getEntity -{ - my ($self, $entity) = @_; - - my $doctype = $self->getDoctype; - - (defined $doctype) ? $doctype->getEntity ($entity) : undef; -} - -sub dispose -{ - my $self = shift; - - $self->[_XmlDecl]->dispose if defined $self->[_XmlDecl]; - undef $self->[_XmlDecl]; # was delete - undef $self->[_Doctype]; # was delete - $self->SUPER::dispose; -} - -sub setOwnerDocument -{ - # Do nothing, you can't change the owner document! -#?? could throw exception... -} - -sub getXMLDecl -{ - $_[0]->[_XmlDecl]; -} - -sub setXMLDecl -{ - $_[0]->[_XmlDecl] = $_[1]; -} - -sub createXMLDecl -{ - new XML::DOM::XMLDecl (@_); -} - -sub createNotation -{ - new XML::DOM::Notation (@_); -} - -sub createElementDecl -{ - new XML::DOM::ElementDecl (@_); -} - -sub createAttlistDecl -{ - new XML::DOM::AttlistDecl (@_); -} - -sub createEntity -{ - new XML::DOM::Entity (@_); -} - -sub createChecker -{ - my $self = shift; - my $checker = XML::Checker->new; - - $checker->Init; - my $doctype = $self->getDoctype; - $doctype->to_expat ($checker) if $doctype; - $checker->Final; - - $checker; -} - -sub check -{ - my ($self, $checker) = @_; - $checker ||= XML::Checker->new; - - $self->to_expat ($checker); -} - -sub to_expat -{ - my ($self, $iter) = @_; - - $iter->Init; - - for my $kid ($self->getChildNodes) - { - $kid->to_expat ($iter); - } - $iter->Final; -} - -sub check_sax -{ - my ($self, $checker) = @_; - $checker ||= XML::Checker->new; - - $self->to_sax (Handler => $checker); -} - -sub _to_sax -{ - my ($self, $doch, $dtdh, $enth) = @_; - - $doch->start_document; - - for my $kid ($self->getChildNodes) - { - $kid->_to_sax ($doch, $dtdh, $enth); - } - $doch->end_document; -} - -###################################################################### -package XML::DOM::DocumentType; -###################################################################### -use vars qw{ @ISA @EXPORT_OK %EXPORT_TAGS %HFIELDS }; - -BEGIN -{ - import XML::DOM::Node qw( :DEFAULT :Fields ); - import XML::DOM::Document qw( :Fields ); - XML::DOM::def_fields ("Entities Notations Name SysId PubId Internal", "XML::DOM::Node"); -} - -use XML::DOM::DOMException; -use XML::DOM::NamedNodeMap; - -sub new -{ - my $class = shift; - my $doc = shift; - - my $self = bless [], $class; - - $self->[_Doc] = $doc; - $self->[_ReadOnly] = 1; - $self->[_C] = new XML::DOM::NodeList; - - $self->[_Entities] = new XML::DOM::NamedNodeMap (Doc => $doc, - Parent => $self, - ReadOnly => 1); - $self->[_Notations] = new XML::DOM::NamedNodeMap (Doc => $doc, - Parent => $self, - ReadOnly => 1); - $self->setParams (@_); - $self; -} - -sub getNodeType -{ - DOCUMENT_TYPE_NODE; -} - -sub getNodeName -{ - $_[0]->[_Name]; -} - -sub getName -{ - $_[0]->[_Name]; -} - -sub getEntities -{ - $_[0]->[_Entities]; -} - -sub getNotations -{ - $_[0]->[_Notations]; -} - -sub setParentNode -{ - my ($self, $parent) = @_; - $self->SUPER::setParentNode ($parent); - - $parent->[_Doctype] = $self - if $parent->getNodeType == DOCUMENT_NODE; -} - -sub cloneNode -{ - my ($self, $deep) = @_; - - my $node = new XML::DOM::DocumentType ($self->[_Doc], $self->[_Name], - $self->[_SysId], $self->[_PubId], - $self->[_Internal]); - -#?? does it make sense to make a shallow copy? - - # clone the NamedNodeMaps - $node->[_Entities] = $self->[_Entities]->cloneNode ($deep); - - $node->[_Notations] = $self->[_Notations]->cloneNode ($deep); - - $node->cloneChildren ($self, $deep); - - $node; -} - -#------------------------------------------------------------ -# Extra method implementations - -sub getSysId -{ - $_[0]->[_SysId]; -} - -sub getPubId -{ - $_[0]->[_PubId]; -} - -sub getInternal -{ - $_[0]->[_Internal]; -} - -sub setSysId -{ - $_[0]->[_SysId] = $_[1]; -} - -sub setPubId -{ - $_[0]->[_PubId] = $_[1]; -} - -sub setInternal -{ - $_[0]->[_Internal] = $_[1]; -} - -sub setName -{ - $_[0]->[_Name] = $_[1]; -} - -sub removeChildHoodMemories -{ - my ($self, $dontWipeReadOnly) = @_; - - my $parent = $self->[_Parent]; - if (defined $parent && $parent->getNodeType == DOCUMENT_NODE) - { - undef $parent->[_Doctype]; # was delete - } - $self->SUPER::removeChildHoodMemories; -} - -sub dispose -{ - my $self = shift; - - $self->[_Entities]->dispose; - $self->[_Notations]->dispose; - $self->SUPER::dispose; -} - -sub setOwnerDocument -{ - my ($self, $doc) = @_; - $self->SUPER::setOwnerDocument ($doc); - - $self->[_Entities]->setOwnerDocument ($doc); - $self->[_Notations]->setOwnerDocument ($doc); -} - -sub expandEntity -{ - my ($self, $ent, $param) = @_; - - my $kid = $self->[_Entities]->getNamedItem ($ent); - return $kid->getValue - if (defined ($kid) && $param == $kid->isParameterEntity); - - undef; # entity not found -} - -sub getAttlistDecl -{ - my ($self, $elemName) = @_; - for my $kid (@{$_[0]->[_C]}) - { - return $kid if ($kid->getNodeType == ATTLIST_DECL_NODE && - $kid->getName eq $elemName); - } - undef; # not found -} - -sub getElementDecl -{ - my ($self, $elemName) = @_; - for my $kid (@{$_[0]->[_C]}) - { - return $kid if ($kid->getNodeType == ELEMENT_DECL_NODE && - $kid->getName eq $elemName); - } - undef; # not found -} - -sub addElementDecl -{ - my ($self, $name, $model, $hidden) = @_; - my $node = $self->getElementDecl ($name); - -#?? could warn - unless (defined $node) - { - $node = $self->[_Doc]->createElementDecl ($name, $model, $hidden); - $self->appendChild ($node); - } - $node; -} - -sub addAttlistDecl -{ - my ($self, $name) = @_; - my $node = $self->getAttlistDecl ($name); - - unless (defined $node) - { - $node = $self->[_Doc]->createAttlistDecl ($name); - $self->appendChild ($node); - } - $node; -} - -sub addNotation -{ - my $self = shift; - my $node = $self->[_Doc]->createNotation (@_); - $self->[_Notations]->setNamedItem ($node); - $node; -} - -sub addEntity -{ - my $self = shift; - my $node = $self->[_Doc]->createEntity (@_); - - $self->[_Entities]->setNamedItem ($node); - $node; -} - -# All AttDefs for a certain Element are merged into a single ATTLIST -sub addAttDef -{ - my $self = shift; - my $elemName = shift; - - # create the AttlistDecl if it doesn't exist yet - my $attListDecl = $self->addAttlistDecl ($elemName); - $attListDecl->addAttDef (@_); -} - -sub getDefaultAttrValue -{ - my ($self, $elem, $attr) = @_; - my $elemNode = $self->getAttlistDecl ($elem); - (defined $elemNode) ? $elemNode->getDefaultAttrValue ($attr) : undef; -} - -sub getEntity -{ - my ($self, $entity) = @_; - $self->[_Entities]->getNamedItem ($entity); -} - -sub setParams -{ - my ($self, $name, $sysid, $pubid, $internal) = @_; - - $self->[_Name] = $name; - -#?? not sure if we need to hold on to these... - $self->[_SysId] = $sysid if defined $sysid; - $self->[_PubId] = $pubid if defined $pubid; - $self->[_Internal] = $internal if defined $internal; - - $self; -} - -sub rejectChild -{ - # DOM Spec says: DocumentType -- no children - not $XML::DOM::IgnoreReadOnly; -} - -sub print -{ - my ($self, $FILE) = @_; - - my $name = $self->[_Name]; - - my $sysId = $self->[_SysId]; - my $pubId = $self->[_PubId]; - - $FILE->print ("print (" PUBLIC \"$pubId\" \"$sysId\""); - } - elsif (defined $sysId) - { - $FILE->print (" SYSTEM \"$sysId\""); - } - - my @entities = @{$self->[_Entities]->getValues}; - my @notations = @{$self->[_Notations]->getValues}; - my @kids = @{$self->[_C]}; - - if (@entities || @notations || @kids) - { - $FILE->print (" [\x0A"); - - for my $kid (@entities) - { - next if $kid->[_Hidden]; - - $FILE->print (" "); - $kid->print ($FILE); - $FILE->print ("\x0A"); - } - - for my $kid (@notations) - { - next if $kid->[_Hidden]; - - $FILE->print (" "); - $kid->print ($FILE); - $FILE->print ("\x0A"); - } - - for my $kid (@kids) - { - next if $kid->[_Hidden]; - - $FILE->print (" "); - $kid->print ($FILE); - $FILE->print ("\x0A"); - } - $FILE->print ("]"); - } - $FILE->print (">"); -} - -sub to_expat -{ - my ($self, $iter) = @_; - - $iter->Doctype ($self->getName, $self->getSysId, $self->getPubId, $self->getInternal); - - for my $ent ($self->getEntities->getValues) - { - next if $ent->[_Hidden]; - $ent->to_expat ($iter); - } - - for my $nota ($self->getNotations->getValues) - { - next if $nota->[_Hidden]; - $nota->to_expat ($iter); - } - - for my $kid ($self->getChildNodes) - { - next if $kid->[_Hidden]; - $kid->to_expat ($iter); - } -} - -sub _to_sax -{ - my ($self, $doch, $dtdh, $enth) = @_; - - $dtdh->doctype_decl ( { Name => $self->getName, - SystemId => $self->getSysId, - PublicId => $self->getPubId, - Internal => $self->getInternal }); - - for my $ent ($self->getEntities->getValues) - { - next if $ent->[_Hidden]; - $ent->_to_sax ($doch, $dtdh, $enth); - } - - for my $nota ($self->getNotations->getValues) - { - next if $nota->[_Hidden]; - $nota->_to_sax ($doch, $dtdh, $enth); - } - - for my $kid ($self->getChildNodes) - { - next if $kid->[_Hidden]; - $kid->_to_sax ($doch, $dtdh, $enth); - } -} - -###################################################################### -package XML::DOM::Parser; -###################################################################### -use vars qw ( @ISA ); -@ISA = qw( XML::Parser ); - -sub new -{ - my ($class, %args) = @_; - - $args{Style} = 'Dom'; - $class->SUPER::new (%args); -} - -# This method needed to be overridden so we can restore some global -# variables when an exception is thrown -sub parse -{ - my $self = shift; - - local $XML::Parser::Dom::_DP_doc; - local $XML::Parser::Dom::_DP_elem; - local $XML::Parser::Dom::_DP_doctype; - local $XML::Parser::Dom::_DP_in_prolog; - local $XML::Parser::Dom::_DP_end_doc; - local $XML::Parser::Dom::_DP_saw_doctype; - local $XML::Parser::Dom::_DP_in_CDATA; - local $XML::Parser::Dom::_DP_keep_CDATA; - local $XML::Parser::Dom::_DP_last_text; - - - # Temporarily disable checks that Expat already does (for performance) - local $XML::DOM::SafeMode = 0; - # Temporarily disable ReadOnly checks - local $XML::DOM::IgnoreReadOnly = 1; - - my $ret; - eval { - $ret = $self->SUPER::parse (@_); - }; - my $err = $@; - - if ($err) - { - my $doc = $XML::Parser::Dom::_DP_doc; - if ($doc) - { - $doc->dispose; - } - die $err; - } - - $ret; -} - -my $LWP_USER_AGENT; -sub set_LWP_UserAgent -{ - $LWP_USER_AGENT = shift; -} - -sub parsefile -{ - my $self = shift; - my $url = shift; - - - # Any other URL schemes? - if ($url =~ /^(https?|ftp|wais|gopher|file):/) - { - # Read the file from the web with LWP. - # - # Note that we read in the entire file, which may not be ideal - # for large files. LWP::UserAgent also provides a callback style - # request, which we could convert to a stream with a fork()... - - my $result; - eval - { - use LWP::UserAgent; - - my $ua = $self->{LWP_UserAgent}; - unless (defined $ua) - { - unless (defined $LWP_USER_AGENT) - { - $LWP_USER_AGENT = LWP::UserAgent->new; - - # Load proxy settings from environment variables, i.e.: - # http_proxy, ftp_proxy, no_proxy etc. (see LWP::UserAgent(3)) - # You need these to go thru firewalls. - $LWP_USER_AGENT->env_proxy; - } - $ua = $LWP_USER_AGENT; - } - my $req = new HTTP::Request 'GET', $url; - my $response = $LWP_USER_AGENT->request ($req); - - # Parse the result of the HTTP request - $result = $self->parse ($response->content, @_); - }; - if ($@) - { - die "Couldn't parsefile [$url] with LWP: $@"; - } - return $result; - } - else - { - return $self->SUPER::parsefile ($url, @_); - } -} - -###################################################################### -package XML::Parser::Dom; -###################################################################### - -BEGIN -{ - import XML::DOM::Node qw( :Fields ); - import XML::DOM::CharacterData qw( :Fields ); -} - -use vars qw( $_DP_doc - $_DP_elem - $_DP_doctype - $_DP_in_prolog - $_DP_end_doc - $_DP_saw_doctype - $_DP_in_CDATA - $_DP_keep_CDATA - $_DP_last_text - $_DP_level - $_DP_expand_pent - ); - -# This adds a new Style to the XML::Parser class. -# From now on you can say: $parser = new XML::Parser ('Style' => 'Dom' ); -# but that is *NOT* how a regular user should use it! -$XML::Parser::Built_In_Styles{Dom} = 1; - -sub Init -{ - $_DP_elem = $_DP_doc = new XML::DOM::Document(); - $_DP_doctype = new XML::DOM::DocumentType ($_DP_doc); - $_DP_doc->setDoctype ($_DP_doctype); - $_DP_keep_CDATA = $_[0]->{KeepCDATA}; - - # Prepare for document prolog - $_DP_in_prolog = 1; - - # We haven't passed the root element yet - $_DP_end_doc = 0; - - # Expand parameter entities in the DTD by default - - $_DP_expand_pent = defined $_[0]->{ExpandParamEnt} ? - $_[0]->{ExpandParamEnt} : 1; - if ($_DP_expand_pent) - { - $_[0]->{DOM_Entity} = {}; - } - - $_DP_level = 0; - - undef $_DP_last_text; -} - -sub Final -{ - unless ($_DP_saw_doctype) - { - my $doctype = $_DP_doc->removeDoctype; - $doctype->dispose; - } - $_DP_doc; -} - -sub Char -{ - my $str = $_[1]; - - if ($_DP_in_CDATA && $_DP_keep_CDATA) - { - undef $_DP_last_text; - # Merge text with previous node if possible - $_DP_elem->addCDATA ($str); - } - else - { - # Merge text with previous node if possible - # Used to be: $expat->{DOM_Element}->addText ($str); - if ($_DP_last_text) - { - $_DP_last_text->[_Data] .= $str; - } - else - { - $_DP_last_text = $_DP_doc->createTextNode ($str); - $_DP_last_text->[_Parent] = $_DP_elem; - push @{$_DP_elem->[_C]}, $_DP_last_text; - } - } -} - -sub Start -{ - my ($expat, $elem, @attr) = @_; - my $parent = $_DP_elem; - my $doc = $_DP_doc; - - if ($parent == $doc) - { - # End of document prolog, i.e. start of first Element - $_DP_in_prolog = 0; - } - - undef $_DP_last_text; - my $node = $doc->createElement ($elem); - $_DP_elem = $node; - $parent->appendChild ($node); - - my $n = @attr; - return unless $n; - - # Add attributes - my $first_default = $expat->specified_attr; - my $i = 0; - while ($i < $n) - { - my $specified = $i < $first_default; - my $name = $attr[$i++]; - undef $_DP_last_text; - my $attr = $doc->createAttribute ($name, $attr[$i++], $specified); - $node->setAttributeNode ($attr); - } -} - -sub End -{ - $_DP_elem = $_DP_elem->[_Parent]; - undef $_DP_last_text; - - # Check for end of root element - $_DP_end_doc = 1 if ($_DP_elem == $_DP_doc); -} - -# Called at end of file, i.e. whitespace following last closing tag -# Also for Entity references -# May also be called at other times... -sub Default -{ - my ($expat, $str) = @_; - -# shift; deb ("Default", @_); - - if ($_DP_in_prolog) # still processing Document prolog... - { -#?? could try to store this text later -#?? I've only seen whitespace here so far - } - elsif (!$_DP_end_doc) # ignore whitespace at end of Document - { -# if ($expat->{NoExpand}) -# { - $str =~ /^&(.+);$/os; - return unless defined ($1); - # Got a TextDecl () from an external entity here once - - $_DP_elem->appendChild ( - $_DP_doc->createEntityReference ($1)); - undef $_DP_last_text; -# } -# else -# { -# $expat->{DOM_Element}->addText ($str); -# } - } -} - -# XML::Parser 2.19 added support for CdataStart and CdataEnd handlers -# If they are not defined, the Default handler is called instead -# with the text "createComment ($_[1]); - $_DP_elem->appendChild ($comment); - } -} - -sub deb -{ -# return; - - my $name = shift; - print "$name (" . join(",", map {defined($_)?$_ : "(undef)"} @_) . ")\n"; -} - -sub Doctype -{ - my $expat = shift; -# deb ("Doctype", @_); - - $_DP_doctype->setParams (@_); - $_DP_saw_doctype = 1; -} - -sub Attlist -{ - my $expat = shift; -# deb ("Attlist", @_); - - $_[5] = "Hidden" unless $_DP_expand_pent || $_DP_level == 0; - $_DP_doctype->addAttDef (@_); -} - -sub XMLDecl -{ - my $expat = shift; -# deb ("XMLDecl", @_); - - undef $_DP_last_text; - $_DP_doc->setXMLDecl (new XML::DOM::XMLDecl ($_DP_doc, @_)); -} - -sub Entity -{ - my $expat = shift; -# deb ("Entity", @_); - - # check to see if Parameter Entity - if ($_[5]) - { - - if (defined $_[2]) # was sysid specified? - { - # Store the Entity mapping for use in ExternEnt - if (exists $expat->{DOM_Entity}->{$_[2]}) - { - # If this ever happens, the name of entity may be the wrong one - # when writing out the Document. - XML::DOM::warning ("Entity $_[2] is known as %$_[0] and %" . - $expat->{DOM_Entity}->{$_[2]}); - } - else - { - $expat->{DOM_Entity}->{$_[2]} = $_[0]; - } - #?? remove this block when XML::Parser has better support - } - } - - undef $_DP_last_text; - - $_[6] = "Hidden" unless $_DP_expand_pent || $_DP_level == 0; - $_DP_doctype->addEntity (@_); -} - -# -# Unparsed is called when it encounters e.g: -# -# -# -sub Unparsed -{ - Entity (@_); # same as regular ENTITY, as far as DOM is concerned -} - -sub Element -{ - shift; -# deb ("Element", @_); - - # put in to convert XML::Parser::ContentModel object to string - # ($_[1] used to be a string in XML::Parser 2.27 and - # dom_attr.t fails if we don't stringify here) - $_[1] = "$_[1]"; - - undef $_DP_last_text; - push @_, "Hidden" unless $_DP_expand_pent || $_DP_level == 0; - $_DP_doctype->addElementDecl (@_); -} - -sub Notation -{ - shift; -# deb ("Notation", @_); - - undef $_DP_last_text; - $_[4] = "Hidden" unless $_DP_expand_pent || $_DP_level == 0; - $_DP_doctype->addNotation (@_); -} - -sub Proc -{ - shift; -# deb ("Proc", @_); - - undef $_DP_last_text; - push @_, "Hidden" unless $_DP_expand_pent || $_DP_level == 0; - $_DP_elem->appendChild ($_DP_doc->createProcessingInstruction (@_)); -} - -# -# ExternEnt is called when an external entity, such as: -# -# -# -# is referenced in the document, e.g. with: &externalEntity; -# If ExternEnt is not specified, the entity reference is passed to the Default -# handler as e.g. "&externalEntity;", where an EntityReference object is added. -# -# Also for %externalEntity; references in the DTD itself. -# -# It can also be called when XML::Parser parses the DOCTYPE header -# (just before calling the DocType handler), when it contains a -# reference like "docbook.dtd" below: -# -# 2.27 since file_ext_ent_handler - # now returns a IO::File object instead of a content string - - # Invoke XML::Parser's default ExternEnt handler - my $content; - if ($XML::Parser::have_LWP) - { - $content = XML::Parser::lwp_ext_ent_handler (@_); - } - else - { - $content = XML::Parser::file_ext_ent_handler (@_); - } - - if ($_DP_expand_pent) - { - return $content; - } - else - { - my $entname = $expat->{DOM_Entity}->{$sysid}; - if (defined $entname) - { - $_DP_doctype->appendChild ($_DP_doc->createEntityReference ($entname, 1)); - # Wrap the contents in special comments, so we know when we reach the - # end of parsing the entity. This way we can omit the contents from - # the DTD, when ExpandParamEnt is set to 0. - - return "" . - $content . ""; - } - else - { - # We either read the entity ref'd by the system id in the - # header, or the entity was undefined. - # In either case, don't bother with maintaining the entity - # reference, just expand the contents. - return "" . - $content . ""; - } - } -} - -1; # module return code - -__END__ - -=head1 NAME - -XML::DOM - A perl module for building DOM Level 1 compliant document structures - -=head1 SYNOPSIS - - use XML::DOM; - - my $parser = new XML::DOM::Parser; - my $doc = $parser->parsefile ("file.xml"); - - # print all HREF attributes of all CODEBASE elements - my $nodes = $doc->getElementsByTagName ("CODEBASE"); - my $n = $nodes->getLength; - - for (my $i = 0; $i < $n; $i++) - { - my $node = $nodes->item ($i); - my $href = $node->getAttributeNode ("HREF"); - print $href->getValue . "\n"; - } - - # Print doc file - $doc->printToFile ("out.xml"); - - # Print to string - print $doc->toString; - - # Avoid memory leaks - cleanup circular references for garbage collection - $doc->dispose; - -=head1 DESCRIPTION - -This module extends the XML::Parser module by Clark Cooper. -The XML::Parser module is built on top of XML::Parser::Expat, -which is a lower level interface to James Clark's expat library. - -XML::DOM::Parser is derived from XML::Parser. It parses XML strings or files -and builds a data structure that conforms to the API of the Document Object -Model as described at http://www.w3.org/TR/REC-DOM-Level-1. -See the XML::Parser manpage for other available features of the -XML::DOM::Parser class. -Note that the 'Style' property should not be used (it is set internally.) - -The XML::Parser I option is more or less supported, in that it will -generate EntityReference objects whenever an entity reference is encountered -in character data. I'm not sure how useful this is. Any comments are welcome. - -As described in the synopsis, when you create an XML::DOM::Parser object, -the parse and parsefile methods create an I object -from the specified input. This Document object can then be examined, modified and -written back out to a file or converted to a string. - -When using XML::DOM with XML::Parser version 2.19 and up, setting the -XML::DOM::Parser option I to 1 will store CDATASections in -CDATASection nodes, instead of converting them to Text nodes. -Subsequent CDATASection nodes will be merged into one. Let me know if this -is a problem. - -When using XML::Parser 2.27 and above, you can suppress expansion of -parameter entity references (e.g. %pent;) in the DTD, by setting I -to 1 and I to 0. See L for details. - -A Document has a tree structure consisting of I objects. A Node may contain -other nodes, depending on its type. -A Document may have Element, Text, Comment, and CDATASection nodes. -Element nodes may have Attr, Element, Text, Comment, and CDATASection nodes. -The other nodes may not have any child nodes. - -This module adds several node types that are not part of the DOM spec (yet.) -These are: ElementDecl (for declarations), AttlistDecl (for - declarations), XMLDecl (for declarations) and AttDef -(for attribute definitions in an AttlistDecl.) - -=head1 XML::DOM Classes - -The XML::DOM module stores XML documents in a tree structure with a root node -of type XML::DOM::Document. Different nodes in tree represent different -parts of the XML file. The DOM Level 1 Specification defines the following -node types: - -=over 4 - -=item * L - Super class of all node types - -=item * L - The root of the XML document - -=item * L - Describes the document structure: - -=item * L - An XML element: ... - -=item * L - An XML element attribute: name="value" - -=item * L - Super class of Text, Comment and CDATASection - -=item * L - Text in an XML element - -=item * L - Escaped block of text: - -=item * L - An XML comment: - -=item * L - Refers to an ENTITY: &ent; or %ent; - -=item * L - An ENTITY definition: - -=item * L - - -=item * L - Lightweight node for cut & paste - -=item * L - An NOTATION definition: - -=back - -In addition, the XML::DOM module contains the following nodes that are not part -of the DOM Level 1 Specification: - -=over 4 - -=item * L - Defines an element: - -=item * L - Defines one or more attributes in an - -=item * L - Defines one attribute in an - -=item * L - An XML declaration: - -=back - -Other classes that are part of the DOM Level 1 Spec: - -=over 4 - -=item * L - Provides information about this implementation. Currently it doesn't do much. - -=item * L - Used internally to store a node's child nodes. Also returned by getElementsByTagName. - -=item * L - Used internally to store an element's attributes. - -=back - -Other classes that are not part of the DOM Level 1 Spec: - -=over 4 - -=item * L - An non-validating XML parser that creates XML::DOM::Documents - -=item * L - A validating XML parser that creates XML::DOM::Documents. It uses L to check against the DocumentType (DTD) - -=item * L - A PerlSAX handler that creates XML::DOM::Documents. - -=back - -=head1 XML::DOM package - -=over 4 - -=item Constant definitions - -The following predefined constants indicate which type of node it is. - -=back - - UNKNOWN_NODE (0) The node type is unknown (not part of DOM) - - ELEMENT_NODE (1) The node is an Element. - ATTRIBUTE_NODE (2) The node is an Attr. - TEXT_NODE (3) The node is a Text node. - CDATA_SECTION_NODE (4) The node is a CDATASection. - ENTITY_REFERENCE_NODE (5) The node is an EntityReference. - ENTITY_NODE (6) The node is an Entity. - PROCESSING_INSTRUCTION_NODE (7) The node is a ProcessingInstruction. - COMMENT_NODE (8) The node is a Comment. - DOCUMENT_NODE (9) The node is a Document. - DOCUMENT_TYPE_NODE (10) The node is a DocumentType. - DOCUMENT_FRAGMENT_NODE (11) The node is a DocumentFragment. - NOTATION_NODE (12) The node is a Notation. - - ELEMENT_DECL_NODE (13) The node is an ElementDecl (not part of DOM) - ATT_DEF_NODE (14) The node is an AttDef (not part of DOM) - XML_DECL_NODE (15) The node is an XMLDecl (not part of DOM) - ATTLIST_DECL_NODE (16) The node is an AttlistDecl (not part of DOM) - - Usage: - - if ($node->getNodeType == ELEMENT_NODE) - { - print "It's an Element"; - } - -B: The DOM Spec does not mention UNKNOWN_NODE and, -quite frankly, you should never encounter it. The last 4 node types were added -to support the 4 added node classes. - -=head2 Global Variables - -=over 4 - -=item $VERSION - -The variable $XML::DOM::VERSION contains the version number of this -implementation, e.g. "1.30". - -=back - -=head2 METHODS - -These methods are not part of the DOM Level 1 Specification. - -=over 4 - -=item getIgnoreReadOnly and ignoreReadOnly (readOnly) - -The DOM Level 1 Spec does not allow you to edit certain sections of the document, -e.g. the DocumentType, so by default this implementation throws DOMExceptions -(i.e. NO_MODIFICATION_ALLOWED_ERR) when you try to edit a readonly node. -These readonly checks can be disabled by (temporarily) setting the global -IgnoreReadOnly flag. - -The ignoreReadOnly method sets the global IgnoreReadOnly flag and returns its -previous value. The getIgnoreReadOnly method simply returns its current value. - - my $oldIgnore = XML::DOM::ignoreReadOnly (1); - eval { - ... do whatever you want, catching any other exceptions ... - }; - XML::DOM::ignoreReadOnly ($oldIgnore); # restore previous value - -Another way to do it, using a local variable: - - { # start new scope - local $XML::DOM::IgnoreReadOnly = 1; - ... do whatever you want, don't worry about exceptions ... - } # end of scope ($IgnoreReadOnly is set back to its previous value) - - -=item isValidName (name) - -Whether the specified name is a valid "Name" as specified in the XML spec. -Characters with Unicode values > 127 are now also supported. - -=item getAllowReservedNames and allowReservedNames (boolean) - -The first method returns whether reserved names are allowed. -The second takes a boolean argument and sets whether reserved names are allowed. -The initial value is 1 (i.e. allow reserved names.) - -The XML spec states that "Names" starting with (X|x)(M|m)(L|l) -are reserved for future use. (Amusingly enough, the XML version of the XML spec -(REC-xml-19980210.xml) breaks that very rule by defining an ENTITY with the name -'xmlpio'.) -A "Name" in this context means the Name token as found in the BNF rules in the -XML spec. - -XML::DOM only checks for errors when you modify the DOM tree, not when the -DOM tree is built by the XML::DOM::Parser. - -=item setTagCompression (funcref) - -There are 3 possible styles for printing empty Element tags: - -=over 4 - -=item Style 0 - - or - -XML::DOM uses this style by default for all Elements. - -=item Style 1 - - or - -=item Style 2 - - or - -This style is sometimes desired when using XHTML. -(Note the extra space before the slash "/") -See L Appendix C for more details. - -=back - -By default XML::DOM compresses all empty Element tags (style 0.) -You can control which style is used for a particular Element by calling -XML::DOM::setTagCompression with a reference to a function that takes -2 arguments. The first is the tag name of the Element, the second is the -XML::DOM::Element that is being printed. -The function should return 0, 1 or 2 to indicate which style should be used to -print the empty tag. E.g. - - XML::DOM::setTagCompression (\&my_tag_compression); - - sub my_tag_compression - { - my ($tag, $elem) = @_; - - # Print empty br, hr and img tags like this:
- return 2 if $tag =~ /^(br|hr|img)$/; - - # Print other empty tags like this: - return 1; - } - -=back - -=head1 IMPLEMENTATION DETAILS - -=over 4 - -=item * Perl Mappings - -The value undef was used when the DOM Spec said null. - -The DOM Spec says: Applications must encode DOMString using UTF-16 (defined in -Appendix C.3 of [UNICODE] and Amendment 1 of [ISO-10646]). -In this implementation we use plain old Perl strings encoded in UTF-8 instead of -UTF-16. - -=item * Text and CDATASection nodes - -The Expat parser expands EntityReferences and CDataSection sections to -raw strings and does not indicate where it was found. -This implementation does therefore convert both to Text nodes at parse time. -CDATASection and EntityReference nodes that are added to an existing Document -(by the user) will be preserved. - -Also, subsequent Text nodes are always merged at parse time. Text nodes that are -added later can be merged with the normalize method. Consider using the addText -method when adding Text nodes. - -=item * Printing and toString - -When printing (and converting an XML Document to a string) the strings have to -encoded differently depending on where they occur. E.g. in a CDATASection all -substrings are allowed except for "]]>". In regular text, certain characters are -not allowed, e.g. ">" has to be converted to ">". -These routines should be verified by someone who knows the details. - -=item * Quotes - -Certain sections in XML are quoted, like attribute values in an Element. -XML::Parser strips these quotes and the print methods in this implementation -always uses double quotes, so when parsing and printing a document, single quotes -may be converted to double quotes. The default value of an attribute definition -(AttDef) in an AttlistDecl, however, will maintain its quotes. - -=item * AttlistDecl - -Attribute declarations for a certain Element are always merged into a single -AttlistDecl object. - -=item * Comments - -Comments in the DOCTYPE section are not kept in the right place. They will become -child nodes of the Document. - -=item * Hidden Nodes - -Previous versions of XML::DOM would expand parameter entity references -(like B<%pent;>), so when printing the DTD, it would print the contents -of the external entity, instead of the parameter entity reference. -With this release (1.27), you can prevent this by setting the XML::DOM::Parser -options ParseParamEnt => 1 and ExpandParamEnt => 0. - -When it is parsing the contents of the external entities, it *DOES* still add -the nodes to the DocumentType, but it marks these nodes by setting -the 'Hidden' property. In addition, it adds an EntityReference node to the -DocumentType node. - -When printing the DocumentType node (or when using to_expat() or to_sax()), -the 'Hidden' nodes are suppressed, so you will see the parameter entity -reference instead of the contents of the external entities. See test case -t/dom_extent.t for an example. - -The reason for adding the 'Hidden' nodes to the DocumentType node, is that -the nodes may contain definitions that are referenced further -in the document. (Simply not adding the nodes to the DocumentType could -cause such entity references to be expanded incorrectly.) - -Note that you need XML::Parser 2.27 or higher for this to work correctly. - -=back - -=head1 SEE ALSO - -The Japanese version of this document by Takanori Kawai (Hippo2000) -at L - -The DOM Level 1 specification at L - -The XML spec (Extensible Markup Language 1.0) at L - -The L and L manual pages. - -L also provides a DOM Parser, and is significantly faster -than XML::DOM, and is under active development. It requires that you -download the Gnome libxml library. - -L will provide the DOM Level 2 Core API, and should be -as fast as XML::LibXML, but more robust, since it uses the memory -management functions of libgdome. For more details see -http://tjmather.com/xml-gdome/ - -=head1 CAVEATS - -The method getElementsByTagName() does not return a "live" NodeList. -Whether this is an actual caveat is debatable, but a few people on the -www-dom mailing list seemed to think so. I haven't decided yet. It's a pain -to implement, it slows things down and the benefits seem marginal. -Let me know what you think. - -(To subscribe to the www-dom mailing list send an email with the subject -"subscribe" to www-dom-request@w3.org. I only look here occasionally, so don't -send bug reports or suggestions about XML::DOM to this list, send them -to tjmather@tjmather.com instead.) - -=head1 AUTHOR - -Enno Derksen is the original author. - -Send bug reports, hints, tips, suggestions to T.J. Mather at ->. - -Thanks to Clark Cooper for his help with the initial version. - -=cut - -=head1 COPYRIGHT - -=for COPYRIGHT BEGIN - -Copyright 2022 University of Southampton. -EPrints 3.4 is supplied by EPrints Services. - -http://www.eprints.org/eprints-3.4/ - -=for COPYRIGHT END - -=for LICENSE BEGIN - -This file is part of EPrints 3.4 L. - -EPrints 3.4 and this file are released under the terms of the -GNU Lesser General Public License version 3 as published by -the Free Software Foundation unless otherwise stated. - -EPrints 3.4 is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -See the GNU Lesser General Public License for more details. - -You should have received a copy of the GNU Lesser General Public -License along with EPrints 3.4. -If not, see L. - -=for LICENSE END - diff --git a/perl_lib/XML/DOM/AttDef.pod b/perl_lib/XML/DOM/AttDef.pod deleted file mode 100644 index b5acb78..0000000 --- a/perl_lib/XML/DOM/AttDef.pod +++ /dev/null @@ -1,36 +0,0 @@ -=head1 NAME - -XML::DOM::AttDef - A single XML attribute definition in an ATTLIST in XML::DOM - -=head1 DESCRIPTION - -XML::DOM::AttDef extends L, but is not part of the DOM Level 1 -specification. - -Each object of this class represents one attribute definition in an AttlistDecl. - -=head2 METHODS - -=over 4 - -=item getName - -Returns the attribute name. - -=item getDefault - -Returns the default value, or undef. - -=item isFixed - -Whether the attribute value is fixed (see #FIXED keyword.) - -=item isRequired - -Whether the attribute value is required (see #REQUIRED keyword.) - -=item isImplied - -Whether the attribute value is implied (see #IMPLIED keyword.) - -=back diff --git a/perl_lib/XML/DOM/AttlistDecl.pod b/perl_lib/XML/DOM/AttlistDecl.pod deleted file mode 100644 index 56f2c71..0000000 --- a/perl_lib/XML/DOM/AttlistDecl.pod +++ /dev/null @@ -1,45 +0,0 @@ -=head1 NAME - -XML::DOM::AttlistDecl - An XML ATTLIST declaration in XML::DOM - -=head1 DESCRIPTION - -XML::DOM::AttlistDecl extends L but is not part of the -DOM Level 1 specification. - -This node represents an ATTLIST declaration, e.g. - - - -Each attribute definition is stored a separate AttDef node. The AttDef nodes can -be retrieved with getAttDef and added with addAttDef. -(The AttDef nodes are stored in a NamedNodeMap internally.) - -=head2 METHODS - -=over 4 - -=item getName - -Returns the Element tagName. - -=item getAttDef (attrName) - -Returns the AttDef node for the attribute with the specified name. - -=item addAttDef (attrName, type, default, [ fixed ]) - -Adds a AttDef node for the attribute with the specified name. - -Parameters: - I the attribute name. - I the attribute type (e.g. "CDATA" or "(male|female)".) - I the default value enclosed in quotes (!), the string #IMPLIED or - the string #REQUIRED. - I whether the attribute is '#FIXED' (default is 0.) - -=back diff --git a/perl_lib/XML/DOM/Attr.pod b/perl_lib/XML/DOM/Attr.pod deleted file mode 100644 index 9305c21..0000000 --- a/perl_lib/XML/DOM/Attr.pod +++ /dev/null @@ -1,67 +0,0 @@ -=head1 NAME - -XML::DOM::Attr - An XML attribute in XML::DOM - -=head1 DESCRIPTION - -XML::DOM::Attr extends L. - -The Attr nodes built by the XML::DOM::Parser always have one child node -which is a Text node containing the expanded string value (i.e. EntityReferences -are always expanded.) EntityReferences may be added when modifying or creating -a new Document. - -The Attr interface represents an attribute in an Element object. -Typically the allowable values for the attribute are defined in a -document type definition. - -Attr objects inherit the Node interface, but since they are not -actually child nodes of the element they describe, the DOM does not -consider them part of the document tree. Thus, the Node attributes -parentNode, previousSibling, and nextSibling have a undef value for Attr -objects. The DOM takes the view that attributes are properties of -elements rather than having a separate identity from the elements they -are associated with; this should make it more efficient to implement -such features as default attributes associated with all elements of a -given type. Furthermore, Attr nodes may not be immediate children of a -DocumentFragment. However, they can be associated with Element nodes -contained within a DocumentFragment. In short, users and implementors -of the DOM need to be aware that Attr nodes have some things in common -with other objects inheriting the Node interface, but they also are -quite distinct. - -The attribute's effective value is determined as follows: if this -attribute has been explicitly assigned any value, that value is the -attribute's effective value; otherwise, if there is a declaration for -this attribute, and that declaration includes a default value, then -that default value is the attribute's effective value; otherwise, the -attribute does not exist on this element in the structure model until -it has been explicitly added. Note that the nodeValue attribute on the -Attr instance can also be used to retrieve the string version of the -attribute's value(s). - -In XML, where the value of an attribute can contain entity references, -the child nodes of the Attr node provide a representation in which -entity references are not expanded. These child nodes may be either -Text or EntityReference nodes. Because the attribute type may be -unknown, there are no tokenized attribute values. - -=head2 METHODS - -=over 4 - -=item getValue - -On retrieval, the value of the attribute is returned as a string. -Character and general entity references are replaced with their values. - -=item setValue (str) - -DOM Spec: On setting, this creates a Text node with the unparsed contents of the -string. - -=item getName - -Returns the name of this attribute. - -=back diff --git a/perl_lib/XML/DOM/CDATASection.pod b/perl_lib/XML/DOM/CDATASection.pod deleted file mode 100644 index 54c26e1..0000000 --- a/perl_lib/XML/DOM/CDATASection.pod +++ /dev/null @@ -1,31 +0,0 @@ -=head1 NAME - -XML::DOM::CDATASection - Escaping XML text blocks in XML::DOM - -=head1 DESCRIPTION - -XML::DOM::CDATASection extends L which extends -L. - -CDATA sections are used to escape blocks of text containing characters -that would otherwise be regarded as markup. The only delimiter that is -recognized in a CDATA section is the "]]>" string that ends the CDATA -section. CDATA sections can not be nested. The primary purpose is for -including material such as XML fragments, without needing to escape all -the delimiters. - -The DOMString attribute of the Text node holds the text that is -contained by the CDATA section. Note that this may contain characters -that need to be escaped outside of CDATA sections and that, depending -on the character encoding ("charset") chosen for serialization, it may -be impossible to write out some characters as part of a CDATA section. - -The CDATASection interface inherits the CharacterData interface through -the Text interface. Adjacent CDATASections nodes are not merged by use -of the Element.normalize() method. - -B XML::DOM::Parser and XML::DOM::ValParser convert all CDATASections -to regular text by default. -To preserve CDATASections, set the parser option KeepCDATA to 1. - - diff --git a/perl_lib/XML/DOM/CharacterData.pod b/perl_lib/XML/DOM/CharacterData.pod deleted file mode 100644 index da591a7..0000000 --- a/perl_lib/XML/DOM/CharacterData.pod +++ /dev/null @@ -1,87 +0,0 @@ -=head1 NAME - -XML::DOM::CharacterData - Common interface for Text, CDATASections and Comments - -=head1 DESCRIPTION - -XML::DOM::CharacterData extends L - -The CharacterData interface extends Node with a set of attributes and -methods for accessing character data in the DOM. For clarity this set -is defined here rather than on each object that uses these attributes -and methods. No DOM objects correspond directly to CharacterData, -though Text, Comment and CDATASection do inherit the interface from it. -All offsets in this interface start from 0. - -=head2 METHODS - -=over 4 - -=item getData and setData (data) - -The character data of the node that implements this -interface. The DOM implementation may not put arbitrary -limits on the amount of data that may be stored in a -CharacterData node. However, implementation limits may mean -that the entirety of a node's data may not fit into a single -DOMString. In such cases, the user may call substringData to -retrieve the data in appropriately sized pieces. - -=item getLength - -The number of characters that are available through data and -the substringData method below. This may have the value zero, -i.e., CharacterData nodes may be empty. - -=item substringData (offset, count) - -Extracts a range of data from the node. - -Parameters: - I Start offset of substring to extract. - I The number of characters to extract. - -Return Value: The specified substring. If the sum of offset and count -exceeds the length, then all characters to the end of -the data are returned. - -=item appendData (str) - -Appends the string to the end of the character data of the -node. Upon success, data provides access to the concatenation -of data and the DOMString specified. - -=item insertData (offset, arg) - -Inserts a string at the specified character offset. - -Parameters: - I The character offset at which to insert. - I The DOMString to insert. - -=item deleteData (offset, count) - -Removes a range of characters from the node. -Upon success, data and length reflect the change. -If the sum of offset and count exceeds length then all characters -from offset to the end of the data are deleted. - -Parameters: - I The offset from which to remove characters. - I The number of characters to delete. - -=item replaceData (offset, count, arg) - -Replaces the characters starting at the specified character -offset with the specified string. - -Parameters: - I The offset from which to start replacing. - I The number of characters to replace. - I The DOMString with which the range must be replaced. - -If the sum of offset and count exceeds length, then all characters to the end of -the data are replaced (i.e., the effect is the same as a remove method call with -the same range, followed by an append method invocation). - -=back diff --git a/perl_lib/XML/DOM/Comment.pod b/perl_lib/XML/DOM/Comment.pod deleted file mode 100644 index f8e2cb2..0000000 --- a/perl_lib/XML/DOM/Comment.pod +++ /dev/null @@ -1,14 +0,0 @@ -=head1 NAME - -XML::DOM::Comment - An XML comment in XML::DOM - -=head1 DESCRIPTION - -XML::DOM::Comment extends L which extends -L. - -This node represents the content of a comment, i.e., all the characters -between the starting ''. Note that this is the -definition of a comment in XML, and, in practice, HTML, although some -HTML tools may implement the full SGML comment structure. - diff --git a/perl_lib/XML/DOM/DOMException.pm b/perl_lib/XML/DOM/DOMException.pm deleted file mode 100644 index b419270..0000000 --- a/perl_lib/XML/DOM/DOMException.pm +++ /dev/null @@ -1,125 +0,0 @@ -=head1 NAME - -XML::DOM::DOMException - -=cut - -###################################################################### -package XML::DOM::DOMException; -###################################################################### - -use Exporter; - -use overload '""' => \&stringify; -use vars qw ( @ISA @EXPORT @ErrorNames ); - -BEGIN -{ - @ISA = qw( Exporter ); - @EXPORT = qw( INDEX_SIZE_ERR - DOMSTRING_SIZE_ERR - HIERARCHY_REQUEST_ERR - WRONG_DOCUMENT_ERR - INVALID_CHARACTER_ERR - NO_DATA_ALLOWED_ERR - NO_MODIFICATION_ALLOWED_ERR - NOT_FOUND_ERR - NOT_SUPPORTED_ERR - INUSE_ATTRIBUTE_ERR - ); -} - -sub UNKNOWN_ERR () {0;} # not in the DOM Spec! -sub INDEX_SIZE_ERR () {1;} -sub DOMSTRING_SIZE_ERR () {2;} -sub HIERARCHY_REQUEST_ERR () {3;} -sub WRONG_DOCUMENT_ERR () {4;} -sub INVALID_CHARACTER_ERR () {5;} -sub NO_DATA_ALLOWED_ERR () {6;} -sub NO_MODIFICATION_ALLOWED_ERR () {7;} -sub NOT_FOUND_ERR () {8;} -sub NOT_SUPPORTED_ERR () {9;} -sub INUSE_ATTRIBUTE_ERR () {10;} - -@ErrorNames = ( - "UNKNOWN_ERR", - "INDEX_SIZE_ERR", - "DOMSTRING_SIZE_ERR", - "HIERARCHY_REQUEST_ERR", - "WRONG_DOCUMENT_ERR", - "INVALID_CHARACTER_ERR", - "NO_DATA_ALLOWED_ERR", - "NO_MODIFICATION_ALLOWED_ERR", - "NOT_FOUND_ERR", - "NOT_SUPPORTED_ERR", - "INUSE_ATTRIBUTE_ERR" - ); -sub new -{ - my ($type, $code, $msg) = @_; - my $self = bless {Code => $code}, $type; - - $self->{Message} = $msg if defined $msg; - -# print "=> Exception: " . $self->stringify . "\n"; - $self; -} - -sub getCode -{ - $_[0]->{Code}; -} - -#------------------------------------------------------------ -# Extra method implementations - -sub getName -{ - $ErrorNames[$_[0]->{Code}]; -} - -sub getMessage -{ - $_[0]->{Message}; -} - -sub stringify -{ - my $self = shift; - - "XML::DOM::DOMException(Code=" . $self->getCode . ", Name=" . - $self->getName . ", Message=" . $self->getMessage . ")"; -} - -1; # package return code - -=head1 COPYRIGHT - -=for COPYRIGHT BEGIN - -Copyright 2022 University of Southampton. -EPrints 3.4 is supplied by EPrints Services. - -http://www.eprints.org/eprints-3.4/ - -=for COPYRIGHT END - -=for LICENSE BEGIN - -This file is part of EPrints 3.4 L. - -EPrints 3.4 and this file are released under the terms of the -GNU Lesser General Public License version 3 as published by -the Free Software Foundation unless otherwise stated. - -EPrints 3.4 is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -See the GNU Lesser General Public License for more details. - -You should have received a copy of the GNU Lesser General Public -License along with EPrints 3.4. -If not, see L. - -=for LICENSE END - diff --git a/perl_lib/XML/DOM/DOMImplementation.pod b/perl_lib/XML/DOM/DOMImplementation.pod deleted file mode 100644 index cb5e34d..0000000 --- a/perl_lib/XML/DOM/DOMImplementation.pod +++ /dev/null @@ -1,24 +0,0 @@ -=head1 NAME - -XML::DOM::DOMImplementation - Information about XML::DOM implementation - -=head1 DESCRIPTION - -The DOMImplementation interface provides a number of methods for -performing operations that are independent of any particular instance -of the document object model. - -The DOM Level 1 does not specify a way of creating a document instance, -and hence document creation is an operation specific to an -implementation. Future Levels of the DOM specification are expected to -provide methods for creating documents directly. - -=head2 METHODS - -=over 4 - -=item hasFeature (feature, version) - -Returns 1 if and only if feature equals "XML" and version equals "1.0". - -=back diff --git a/perl_lib/XML/DOM/Document.pod b/perl_lib/XML/DOM/Document.pod deleted file mode 100644 index f8e7b81..0000000 --- a/perl_lib/XML/DOM/Document.pod +++ /dev/null @@ -1,220 +0,0 @@ -=head1 NAME - -XML::DOM::Document - An XML document node in XML::DOM - -=head1 DESCRIPTION - -XML::DOM::Document extends L. - -It is the main root of the XML document structure as returned by -XML::DOM::Parser::parse and XML::DOM::Parser::parsefile. - -Since elements, text nodes, comments, processing instructions, etc. -cannot exist outside the context of a Document, the Document interface -also contains the factory methods needed to create these objects. The -Node objects created have a getOwnerDocument method which associates -them with the Document within whose context they were created. - -=head2 METHODS - -=over 4 - -=item getDocumentElement - -This is a convenience method that allows direct access to -the child node that is the root Element of the document. - -=item getDoctype - -The Document Type Declaration (see DocumentType) associated -with this document. For HTML documents as well as XML -documents without a document type declaration this returns -undef. The DOM Level 1 does not support editing the Document -Type Declaration. - -B: This implementation allows editing the doctype. -See I for details. - -=item getImplementation - -The DOMImplementation object that handles this document. A -DOM application may use objects from multiple implementations. - -=item createElement (tagName) - -Creates an element of the type specified. Note that the -instance returned implements the Element interface, so -attributes can be specified directly on the returned object. - -DOMExceptions: - -=over 4 - -=item * INVALID_CHARACTER_ERR - -Raised if the tagName does not conform to the XML spec. - -=back - -=item createTextNode (data) - -Creates a Text node given the specified string. - -=item createComment (data) - -Creates a Comment node given the specified string. - -=item createCDATASection (data) - -Creates a CDATASection node given the specified string. - -=item createAttribute (name [, value [, specified ]]) - -Creates an Attr of the given name. Note that the Attr -instance can then be set on an Element using the setAttribute method. - -B: The DOM Spec does not allow passing the value or the -specified property in this method. In this implementation they are optional. - -Parameters: - I The attribute's value. See Attr::setValue for details. - If the value is not supplied, the specified property is set to 0. - I Whether the attribute value was specified or whether the default - value was used. If not supplied, it's assumed to be 1. - -DOMExceptions: - -=over 4 - -=item * INVALID_CHARACTER_ERR - -Raised if the name does not conform to the XML spec. - -=back - -=item createProcessingInstruction (target, data) - -Creates a ProcessingInstruction node given the specified name and data strings. - -Parameters: - I The target part of the processing instruction. - I The data for the node. - -DOMExceptions: - -=over 4 - -=item * INVALID_CHARACTER_ERR - -Raised if the target does not conform to the XML spec. - -=back - -=item createDocumentFragment - -Creates an empty DocumentFragment object. - -=item createEntityReference (name) - -Creates an EntityReference object. - -=back - -=head2 Additional methods not in the DOM Spec - -=over 4 - -=item getXMLDecl and setXMLDecl (xmlDecl) - -Returns the XMLDecl for this Document or undef if none was specified. -Note that XMLDecl is not part of the list of child nodes. - -=item setDoctype (doctype) - -Sets or replaces the DocumentType. -B: Don't use appendChild or insertBefore to set the DocumentType. -Even though doctype will be part of the list of child nodes, it is handled -specially. - -=item getDefaultAttrValue (elem, attr) - -Returns the default attribute value as a string or undef, if none is available. - -Parameters: - I The element tagName. - I The attribute name. - -=item getEntity (name) - -Returns the Entity with the specified name. - -=item createXMLDecl (version, encoding, standalone) - -Creates an XMLDecl object. All parameters may be undefined. - -=item createDocumentType (name, sysId, pubId) - -Creates a DocumentType object. SysId and pubId may be undefined. - -=item createNotation (name, base, sysId, pubId) - -Creates a new Notation object. Consider using -XML::DOM::DocumentType::addNotation! - -=item createEntity (parameter, notationName, value, sysId, pubId, ndata) - -Creates an Entity object. Consider using XML::DOM::DocumentType::addEntity! - -=item createElementDecl (name, model) - -Creates an ElementDecl object. - -DOMExceptions: - -=over 4 - -=item * INVALID_CHARACTER_ERR - -Raised if the element name (tagName) does not conform to the XML spec. - -=back - -=item createAttlistDecl (name) - -Creates an AttlistDecl object. - -DOMExceptions: - -=over 4 - -=item * INVALID_CHARACTER_ERR - -Raised if the element name (tagName) does not conform to the XML spec. - -=back - -=item expandEntity (entity [, parameter]) - -Expands the specified entity or parameter entity (if parameter=1) and returns -its value as a string, or undef if the entity does not exist. -(The entity name should not contain the '%', '&' or ';' delimiters.) - -=item check ( [$checker] ) - -Uses the specified L to validate the document. -If no XML::Checker is supplied, a new XML::Checker is created. -See L for details. - -=item check_sax ( [$checker] ) - -Similar to check() except it uses the SAX interface to XML::Checker instead of -the expat interface. This method may disappear or replace check() at some time. - -=item createChecker () - -Creates an XML::Checker based on the document's DTD. -The $checker can be reused to check any elements within the document. -Create a new L whenever the DOCTYPE section of the document -is altered! - -=back diff --git a/perl_lib/XML/DOM/DocumentFragment.pod b/perl_lib/XML/DOM/DocumentFragment.pod deleted file mode 100644 index aae2cd6..0000000 --- a/perl_lib/XML/DOM/DocumentFragment.pod +++ /dev/null @@ -1,40 +0,0 @@ -=head1 NAME - -XML::DOM::DocumentFragment - Facilitates cut & paste in XML::DOM documents - -=head1 DESCRIPTION - -XML::DOM::DocumentFragment extends L - -DocumentFragment is a "lightweight" or "minimal" Document object. It is -very common to want to be able to extract a portion of a document's -tree or to create a new fragment of a document. Imagine implementing a -user command like cut or rearranging a document by moving fragments -around. It is desirable to have an object which can hold such fragments -and it is quite natural to use a Node for this purpose. While it is -true that a Document object could fulfil this role, a Document object -can potentially be a heavyweight object, depending on the underlying -implementation. What is really needed for this is a very lightweight -object. DocumentFragment is such an object. - -Furthermore, various operations -- such as inserting nodes as children -of another Node -- may take DocumentFragment objects as arguments; this -results in all the child nodes of the DocumentFragment being moved to -the child list of this node. - -The children of a DocumentFragment node are zero or more nodes -representing the tops of any sub-trees defining the structure of the -document. DocumentFragment nodes do not need to be well-formed XML -documents (although they do need to follow the rules imposed upon -well-formed XML parsed entities, which can have multiple top nodes). -For example, a DocumentFragment might have only one child and that -child node could be a Text node. Such a structure model represents -neither an HTML document nor a well-formed XML document. - -When a DocumentFragment is inserted into a Document (or indeed any -other Node that may take children) the children of the DocumentFragment -and not the DocumentFragment itself are inserted into the Node. This -makes the DocumentFragment very useful when the user wishes to create -nodes that are siblings; the DocumentFragment acts as the parent of -these nodes so that the user can use the standard methods from the Node -interface, such as insertBefore() and appendChild(). diff --git a/perl_lib/XML/DOM/DocumentType.pod b/perl_lib/XML/DOM/DocumentType.pod deleted file mode 100644 index 6975e49..0000000 --- a/perl_lib/XML/DOM/DocumentType.pod +++ /dev/null @@ -1,182 +0,0 @@ -=head1 NAME - -XML::DOM::DocumentType - An XML document type (DTD) in XML::DOM - -=head1 DESCRIPTION - -XML::DOM::DocumentType extends L. - -Each Document has a doctype attribute whose value is either null or a -DocumentType object. The DocumentType interface in the DOM Level 1 Core -provides an interface to the list of entities that are defined for the -document, and little else because the effect of namespaces and the -various XML scheme efforts on DTD representation are not clearly -understood as of this writing. -The DOM Level 1 doesn't support editing DocumentType nodes. - -B: This implementation has added a lot of extra -functionality to the DOM Level 1 interface. -To allow editing of the DocumentType nodes, see XML::DOM::ignoreReadOnly. - -=head2 METHODS - -=over 4 - -=item getName - -Returns the name of the DTD, i.e. the name immediately following the -DOCTYPE keyword. - -=item getEntities - -A NamedNodeMap containing the general entities, both external -and internal, declared in the DTD. Duplicates are discarded. -For example in: - - - - - ]> - - -the interface provides access to foo and bar but not baz. -Every node in this map also implements the Entity interface. - -The DOM Level 1 does not support editing entities, therefore -entities cannot be altered in any way. - -B: See XML::DOM::ignoreReadOnly to edit the DocumentType etc. - -=item getNotations - -A NamedNodeMap containing the notations declared in the DTD. -Duplicates are discarded. Every node in this map also -implements the Notation interface. - -The DOM Level 1 does not support editing notations, therefore -notations cannot be altered in any way. - -B: See XML::DOM::ignoreReadOnly to edit the DocumentType etc. - -=head2 Additional methods not in the DOM Spec - -=item Creating and setting the DocumentType - -A new DocumentType can be created with: - - $doctype = $doc->createDocumentType ($name, $sysId, $pubId, $internal); - -To set (or replace) the DocumentType for a particular document, use: - - $doc->setDocType ($doctype); - -=item getSysId and setSysId (sysId) - -Returns or sets the system id. - -=item getPubId and setPubId (pudId) - -Returns or sets the public id. - -=item setName (name) - -Sets the name of the DTD, i.e. the name immediately following the -DOCTYPE keyword. Note that this should always be the same as the element -tag name of the root element. - -=item getAttlistDecl (elemName) - -Returns the AttlistDecl for the Element with the specified name, or undef. - -=item getElementDecl (elemName) - -Returns the ElementDecl for the Element with the specified name, or undef. - -=item getEntity (entityName) - -Returns the Entity with the specified name, or undef. - -=item addAttlistDecl (elemName) - -Adds a new AttDecl node with the specified elemName if one doesn't exist yet. -Returns the AttlistDecl (new or existing) node. - -=item addElementDecl (elemName, model) - -Adds a new ElementDecl node with the specified elemName and model if one doesn't -exist yet. -Returns the AttlistDecl (new or existing) node. The model is ignored if one -already existed. - -=item addEntity (parameter, notationName, value, sysId, pubId, ndata) - -Adds a new Entity node. Don't use createEntity and appendChild, because it should -be added to the internal NamedNodeMap containing the entities. - -Parameters: - I whether it is a parameter entity (%ent;) or not (&ent;). - I the entity name. - I the entity value. - I the system id (if any.) - I the public id (if any.) - I the NDATA declaration (if any, for general unparsed entities.) - -SysId, pubId and ndata may be undefined. - -DOMExceptions: - -=over 4 - -=item * INVALID_CHARACTER_ERR - -Raised if the notationName does not conform to the XML spec. - -=back - -=item addNotation (name, base, sysId, pubId) - -Adds a new Notation object. - -Parameters: - I the notation name. - I the base to be used for resolving a relative URI. - I the system id. - I the public id. - -Base, sysId, and pubId may all be undefined. -(These parameters are passed by the XML::Parser Notation handler.) - -DOMExceptions: - -=over 4 - -=item * INVALID_CHARACTER_ERR - -Raised if the notationName does not conform to the XML spec. - -=back - -=item addAttDef (elemName, attrName, type, default, fixed) - -Adds a new attribute definition. It will add the AttDef node to the AttlistDecl -if it exists. If an AttDef with the specified attrName already exists for the -given elemName, this function only generates a warning. - -See XML::DOM::AttDef::new for the other parameters. - -=item getDefaultAttrValue (elem, attr) - -Returns the default attribute value as a string or undef, if none is available. - -Parameters: - I The element tagName. - I The attribute name. - -=item expandEntity (entity [, parameter]) - -Expands the specified entity or parameter entity (if parameter=1) and returns -its value as a string, or undef if the entity does not exist. -(The entity name should not contain the '%', '&' or ';' delimiters.) - -=back diff --git a/perl_lib/XML/DOM/Element.pod b/perl_lib/XML/DOM/Element.pod deleted file mode 100644 index dccceb0..0000000 --- a/perl_lib/XML/DOM/Element.pod +++ /dev/null @@ -1,189 +0,0 @@ -=head1 NAME - -XML::DOM::Element - An XML element node in XML::DOM - -=head1 DESCRIPTION - -XML::DOM::Element extends L. - -By far the vast majority of objects (apart from text) that authors -encounter when traversing a document are Element nodes. Assume the -following XML document: - - - - - - -When represented using DOM, the top node is an Element node for -"elementExample", which contains two child Element nodes, one for -"subelement1" and one for "subelement2". "subelement1" contains no -child nodes. - -Elements may have attributes associated with them; since the Element -interface inherits from Node, the generic Node interface method -getAttributes may be used to retrieve the set of all attributes for an -element. There are methods on the Element interface to retrieve either -an Attr object by name or an attribute value by name. In XML, where an -attribute value may contain entity references, an Attr object should be -retrieved to examine the possibly fairly complex sub-tree representing -the attribute value. On the other hand, in HTML, where all attributes -have simple string values, methods to directly access an attribute -value can safely be used as a convenience. - -=head2 METHODS - -=over 4 - -=item getTagName - -The name of the element. For example, in: - - - ... - - -tagName has the value "elementExample". Note that this is -case-preserving in XML, as are all of the operations of the -DOM. - -=item getAttribute (name) - -Retrieves an attribute value by name. - -Return Value: The Attr value as a string, or the empty string if that -attribute does not have a specified or default value. - -=item setAttribute (name, value) - -Adds a new attribute. If an attribute with that name is -already present in the element, its value is changed to be -that of the value parameter. This value is a simple string, -it is not parsed as it is being set. So any markup (such as -syntax to be recognized as an entity reference) is treated as -literal text, and needs to be appropriately escaped by the -implementation when it is written out. In order to assign an -attribute value that contains entity references, the user -must create an Attr node plus any Text and EntityReference -nodes, build the appropriate subtree, and use -setAttributeNode to assign it as the value of an attribute. - - -DOMExceptions: - -=over 4 - -=item * INVALID_CHARACTER_ERR - -Raised if the specified name contains an invalid character. - -=item * NO_MODIFICATION_ALLOWED_ERR - -Raised if this node is readonly. - -=back - -=item removeAttribute (name) - -Removes an attribute by name. If the removed attribute has a -default value it is immediately replaced. - -DOMExceptions: - -=over 4 - -=item * NO_MODIFICATION_ALLOWED_ERR - -Raised if this node is readonly. - -=back - -=item getAttributeNode - -Retrieves an Attr node by name. - -Return Value: The Attr node with the specified attribute name or undef -if there is no such attribute. - -=item setAttributeNode (attr) - -Adds a new attribute. If an attribute with that name is -already present in the element, it is replaced by the new one. - -Return Value: If the newAttr attribute replaces an existing attribute -with the same name, the previously existing Attr node is -returned, otherwise undef is returned. - -DOMExceptions: - -=over 4 - -=item * WRONG_DOCUMENT_ERR - -Raised if newAttr was created from a different document than the one that created -the element. - -=item * NO_MODIFICATION_ALLOWED_ERR - -Raised if this node is readonly. - -=item * INUSE_ATTRIBUTE_ERR - -Raised if newAttr is already an attribute of another Element object. The DOM -user must explicitly clone Attr nodes to reuse them in other elements. - -=back - -=item removeAttributeNode (oldAttr) - -Removes the specified attribute. If the removed Attr has a default value it is -immediately replaced. If the Attr already is the default value, nothing happens -and nothing is returned. - -Parameters: - I The Attr node to remove from the attribute list. - -Return Value: The Attr node that was removed. - -DOMExceptions: - -=over 4 - -=item * NO_MODIFICATION_ALLOWED_ERR - -Raised if this node is readonly. - -=item * NOT_FOUND_ERR - -Raised if oldAttr is not an attribute of the element. - -=back - -=head2 Additional methods not in the DOM Spec - -=over 4 - -=item setTagName (newTagName) - -Sets the tag name of the Element. Note that this method is not portable -between DOM implementations. - -DOMExceptions: - -=over 4 - -=item * INVALID_CHARACTER_ERR - -Raised if the specified name contains an invalid character. - -=back - -=item check ($checker) - -Uses the specified L to validate the document. -NOTE: an XML::Checker must be supplied. The checker can be created in -different ways, e.g. when parsing a document with XML::DOM::ValParser, -or with XML::DOM::Document::createChecker(). -See L for more info. - -=back diff --git a/perl_lib/XML/DOM/ElementDecl.pod b/perl_lib/XML/DOM/ElementDecl.pod deleted file mode 100644 index dd59b69..0000000 --- a/perl_lib/XML/DOM/ElementDecl.pod +++ /dev/null @@ -1,27 +0,0 @@ -=head1 NAME - -XML::DOM::ElementDecl - An XML ELEMENT declaration in XML::DOM - -=head1 DESCRIPTION - -XML::DOM::ElementDecl extends L but is not part of the -DOM Level 1 specification. - -This node represents an Element declaration, e.g. - - - -=head2 METHODS - -=over 4 - -=item getName - -Returns the Element tagName. - -=item getModel and setModel (model) - -Returns and sets the model as a string, e.g. -"(street+, city, state, zip, country?)" in the above example. - -=back diff --git a/perl_lib/XML/DOM/Entity.pod b/perl_lib/XML/DOM/Entity.pod deleted file mode 100644 index 45418e8..0000000 --- a/perl_lib/XML/DOM/Entity.pod +++ /dev/null @@ -1,56 +0,0 @@ -=head1 NAME - -XML::DOM::Entity - An XML ENTITY in XML::DOM - -=head1 DESCRIPTION - -XML::DOM::Entity extends L. - -This node represents an Entity declaration, e.g. - - - - - -The first one is called a parameter entity and is referenced like this: %draft; -The 2nd is a (regular) entity and is referenced like this: &hatch-pic; - -=head2 METHODS - -=over 4 - -=item getNotationName - -Returns the name of the notation for the entity. - -I The DOM Spec says: For unparsed entities, the name of the -notation for the entity. For parsed entities, this is null. -(This implementation does not support unparsed entities.) - -=item getSysId - -Returns the system id, or undef. - -=item getPubId - -Returns the public id, or undef. - -=back - -=head2 Additional methods not in the DOM Spec - -=over 4 - -=item isParameterEntity - -Whether it is a parameter entity (%ent;) or not (&ent;) - -=item getValue - -Returns the entity value. - -=item getNdata - -Returns the NDATA declaration (for general unparsed entities), or undef. - -=back diff --git a/perl_lib/XML/DOM/EntityReference.pod b/perl_lib/XML/DOM/EntityReference.pod deleted file mode 100644 index 4ecda31..0000000 --- a/perl_lib/XML/DOM/EntityReference.pod +++ /dev/null @@ -1,27 +0,0 @@ -=head1 NAME - -XML::DOM::EntityReference - An XML ENTITY reference in XML::DOM - -=head1 DESCRIPTION - -XML::DOM::EntityReference extends L. - -EntityReference objects may be inserted into the structure model when -an entity reference is in the source document, or when the user wishes -to insert an entity reference. Note that character references and -references to predefined entities are considered to be expanded by the -HTML or XML processor so that characters are represented by their -Unicode equivalent rather than by an entity reference. Moreover, the -XML processor may completely expand references to entities while -building the structure model, instead of providing EntityReference -objects. If it does provide such objects, then for a given -EntityReference node, it may be that there is no Entity node -representing the referenced entity; but if such an Entity exists, then -the child list of the EntityReference node is the same as that of the -Entity node. As with the Entity node, all descendants of the -EntityReference are readonly. - -The resolution of the children of the EntityReference (the replacement -value of the referenced Entity) may be lazily evaluated; actions by the -user (such as calling the childNodes method on the EntityReference -node) are assumed to trigger the evaluation. diff --git a/perl_lib/XML/DOM/NamedNodeMap.pm b/perl_lib/XML/DOM/NamedNodeMap.pm deleted file mode 100644 index b996be4..0000000 --- a/perl_lib/XML/DOM/NamedNodeMap.pm +++ /dev/null @@ -1,308 +0,0 @@ -=head1 NAME - -XML::DOM::NamedNodeMap - -=cut - -###################################################################### -package XML::DOM::NamedNodeMap; -###################################################################### - -use strict; - -use Carp; -use XML::DOM::DOMException; -use XML::DOM::NodeList; - -use vars qw( $Special ); - -# Constant definition: -# Note: a real Name should have at least 1 char, so nobody else should use this -$Special = ""; - -sub new -{ - my ($class, %args) = @_; - - $args{Values} = new XML::DOM::NodeList; - - # Store all NamedNodeMap properties in element $Special - bless { $Special => \%args}, $class; -} - -sub getNamedItem -{ - # Don't return the $Special item! - ($_[1] eq $Special) ? undef : $_[0]->{$_[1]}; -} - -sub setNamedItem -{ - my ($self, $node) = @_; - my $prop = $self->{$Special}; - - my $name = $node->getNodeName; - - if ($XML::DOM::SafeMode) - { - croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR) - if $self->isReadOnly; - - croak new XML::DOM::DOMException (WRONG_DOCUMENT_ERR) - if $node->[XML::DOM::Node::_Doc] != $prop->{Doc}; - - croak new XML::DOM::DOMException (INUSE_ATTRIBUTE_ERR) - if defined ($node->[XML::DOM::Node::_UsedIn]); - - croak new XML::DOM::DOMException (INVALID_CHARACTER_ERR, - "can't add name with NodeName [$name] to NamedNodeMap") - if $name eq $Special; - } - - my $values = $prop->{Values}; - my $index = -1; - - my $prev = $self->{$name}; - if (defined $prev) - { - # decouple previous node - $prev->decoupleUsedIn; - - # find index of $prev - $index = 0; - for my $val (@{$values}) - { - last if ($val == $prev); - $index++; - } - } - - $self->{$name} = $node; - $node->[XML::DOM::Node::_UsedIn] = $self; - - if ($index == -1) - { - push (@{$values}, $node); - } - else # replace previous node with new node - { - splice (@{$values}, $index, 1, $node); - } - - $prev; -} - -sub removeNamedItem -{ - my ($self, $name) = @_; - - # Be careful that user doesn't delete $Special node! - croak new XML::DOM::DOMException (NOT_FOUND_ERR) - if $name eq $Special; - - my $node = $self->{$name}; - - croak new XML::DOM::DOMException (NOT_FOUND_ERR) - unless defined $node; - - # The DOM Spec doesn't mention this Exception - I think it's an oversight - croak new XML::DOM::DOMException (NO_MODIFICATION_ALLOWED_ERR) - if $self->isReadOnly; - - $node->decoupleUsedIn; - delete $self->{$name}; - - # remove node from Values list - my $values = $self->getValues; - my $index = 0; - for my $val (@{$values}) - { - if ($val == $node) - { - splice (@{$values}, $index, 1, ()); - last; - } - $index++; - } - $node; -} - -# The following 2 are really bogus. DOM should use an iterator instead (Clark) - -sub item -{ - my ($self, $item) = @_; - $self->{$Special}->{Values}->[$item]; -} - -sub getLength -{ - my ($self) = @_; - my $vals = $self->{$Special}->{Values}; - int (@$vals); -} - -#------------------------------------------------------------ -# Extra method implementations - -sub isReadOnly -{ - return 0 if $XML::DOM::IgnoreReadOnly; - - my $used = $_[0]->{$Special}->{UsedIn}; - defined $used ? $used->isReadOnly : 0; -} - -sub cloneNode -{ - my ($self, $deep) = @_; - my $prop = $self->{$Special}; - - my $map = new XML::DOM::NamedNodeMap (Doc => $prop->{Doc}); - # Not copying Parent property on purpose! - - local $XML::DOM::IgnoreReadOnly = 1; # temporarily... - - for my $val (@{$prop->{Values}}) - { - my $key = $val->getNodeName; - - my $newNode = $val->cloneNode ($deep); - $newNode->[XML::DOM::Node::_UsedIn] = $map; - $map->{$key} = $newNode; - push (@{$map->{$Special}->{Values}}, $newNode); - } - - $map; -} - -sub setOwnerDocument -{ - my ($self, $doc) = @_; - my $special = $self->{$Special}; - - $special->{Doc} = $doc; - for my $kid (@{$special->{Values}}) - { - $kid->setOwnerDocument ($doc); - } -} - -sub getChildIndex -{ - my ($self, $attr) = @_; - my $i = 0; - for my $kid (@{$self->{$Special}->{Values}}) - { - return $i if $kid == $attr; - $i++; - } - -1; # not found -} - -sub getValues -{ - wantarray ? @{ $_[0]->{$Special}->{Values} } : $_[0]->{$Special}->{Values}; -} - -# Remove circular dependencies. The NamedNodeMap and its values should -# not be used afterwards. -sub dispose -{ - my $self = shift; - - for my $kid (@{$self->getValues}) - { - undef $kid->[XML::DOM::Node::_UsedIn]; # was delete - $kid->dispose; - } - - delete $self->{$Special}->{Doc}; - delete $self->{$Special}->{Parent}; - delete $self->{$Special}->{Values}; - - for my $key (keys %$self) - { - delete $self->{$key}; - } -} - -sub setParentNode -{ - $_[0]->{$Special}->{Parent} = $_[1]; -} - -sub getProperty -{ - $_[0]->{$Special}->{$_[1]}; -} - -#?? remove after debugging -sub toString -{ - my ($self) = @_; - my $str = "NamedNodeMap["; - while (my ($key, $val) = each %$self) - { - if ($key eq $Special) - { - $str .= "##Special ("; - while (my ($k, $v) = each %$val) - { - if ($k eq "Values") - { - $str .= $k . " => ["; - for my $a (@$v) - { -# $str .= $a->getNodeName . "=" . $a . ","; - $str .= $a->toString . ","; - } - $str .= "], "; - } - else - { - $str .= $k . " => " . $v . ", "; - } - } - $str .= "), "; - } - else - { - $str .= $key . " => " . $val . ", "; - } - } - $str . "]"; -} - -1; # package return code - -=head1 COPYRIGHT - -=for COPYRIGHT BEGIN - -Copyright 2022 University of Southampton. -EPrints 3.4 is supplied by EPrints Services. - -http://www.eprints.org/eprints-3.4/ - -=for COPYRIGHT END - -=for LICENSE BEGIN - -This file is part of EPrints 3.4 L. - -EPrints 3.4 and this file are released under the terms of the -GNU Lesser General Public License version 3 as published by -the Free Software Foundation unless otherwise stated. - -EPrints 3.4 is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -See the GNU Lesser General Public License for more details. - -You should have received a copy of the GNU Lesser General Public -License along with EPrints 3.4. -If not, see L. - -=for LICENSE END - diff --git a/perl_lib/XML/DOM/NamedNodeMap.pod b/perl_lib/XML/DOM/NamedNodeMap.pod deleted file mode 100644 index 05da1e9..0000000 --- a/perl_lib/XML/DOM/NamedNodeMap.pod +++ /dev/null @@ -1,130 +0,0 @@ -=head1 NAME - -XML::DOM::NamedNodeMap - A hash table interface for XML::DOM - -=head1 DESCRIPTION - -Objects implementing the NamedNodeMap interface are used to represent -collections of nodes that can be accessed by name. Note that -NamedNodeMap does not inherit from NodeList; NamedNodeMaps are not -maintained in any particular order. Objects contained in an object -implementing NamedNodeMap may also be accessed by an ordinal index, but -this is simply to allow convenient enumeration of the contents of a -NamedNodeMap, and does not imply that the DOM specifies an order to -these Nodes. - -Note that in this implementation, the objects added to a NamedNodeMap -are kept in order. - -=head2 METHODS - -=over 4 - -=item getNamedItem (name) - -Retrieves a node specified by name. - -Return Value: A Node (of any type) with the specified name, or undef if -the specified name did not identify any node in the map. - -=item setNamedItem (arg) - -Adds a node using its nodeName attribute. - -As the nodeName attribute is used to derive the name which -the node must be stored under, multiple nodes of certain -types (those that have a "special" string value) cannot be -stored as the names would clash. This is seen as preferable -to allowing nodes to be aliased. - -Parameters: - I A node to store in a named node map. - -The node will later be accessible using the value of the nodeName -attribute of the node. If a node with that name is -already present in the map, it is replaced by the new one. - -Return Value: If the new Node replaces an existing node with the same -name the previously existing Node is returned, otherwise undef is returned. - -DOMExceptions: - -=over 4 - -=item * WRONG_DOCUMENT_ERR - -Raised if arg was created from a different document than the one that -created the NamedNodeMap. - -=item * NO_MODIFICATION_ALLOWED_ERR - -Raised if this NamedNodeMap is readonly. - -=item * INUSE_ATTRIBUTE_ERR - -Raised if arg is an Attr that is already an attribute of another Element object. -The DOM user must explicitly clone Attr nodes to reuse them in other elements. - -=back - -=item removeNamedItem (name) - -Removes a node specified by name. If the removed node is an -Attr with a default value it is immediately replaced. - -Return Value: The node removed from the map or undef if no node with -such a name exists. - -DOMException: - -=over 4 - -=item * NOT_FOUND_ERR - -Raised if there is no node named name in the map. - -=back - -=item item (index) - -Returns the indexth item in the map. If index is greater than -or equal to the number of nodes in the map, this returns undef. - -Return Value: The node at the indexth position in the NamedNodeMap, or -undef if that is not a valid index. - -=item getLength - -Returns the number of nodes in the map. The range of valid child node -indices is 0 to length-1 inclusive. - -=back - -=head2 Additional methods not in the DOM Spec - -=over 4 - -=item getValues - -Returns a NodeList with the nodes contained in the NamedNodeMap. -The NodeList is "live", in that it reflects changes made to the NamedNodeMap. - -When this method is called in a list context, it returns a regular perl list -containing the values. Note that this list is not "live". E.g. - - @list = $map->getValues; # returns a perl list - $nodelist = $map->getValues; # returns a NodeList (object ref.) - for my $val ($map->getValues) # iterate over the values - -=item getChildIndex (node) - -Returns the index of the node in the NodeList as returned by getValues, or -1 -if the node is not in the NamedNodeMap. - -=item dispose - -Removes all circular references in this NamedNodeMap and its descendants so the -objects can be claimed for garbage collection. The objects should not be used -afterwards. - -=back diff --git a/perl_lib/XML/DOM/Node.pod b/perl_lib/XML/DOM/Node.pod deleted file mode 100644 index 0129cc5..0000000 --- a/perl_lib/XML/DOM/Node.pod +++ /dev/null @@ -1,451 +0,0 @@ -=head1 NAME - -XML::DOM::Node - Super class of all nodes in XML::DOM - -=head1 DESCRIPTION - -XML::DOM::Node is the super class of all nodes in an XML::DOM document. -This means that all nodes that subclass XML::DOM::Node also inherit all -the methods that XML::DOM::Node implements. - -=head2 GLOBAL VARIABLES - -=over 4 - -=item @NodeNames - -The variable @XML::DOM::Node::NodeNames maps the node type constants to strings. -It is used by XML::DOM::Node::getNodeTypeName. - -=back - -=head2 METHODS - -=over 4 - -=item getNodeType - -Return an integer indicating the node type. See XML::DOM constants. - -=item getNodeName - -Return a property or a hardcoded string, depending on the node type. -Here are the corresponding functions or values: - - Attr getName - AttDef getName - AttlistDecl getName - CDATASection "#cdata-section" - Comment "#comment" - Document "#document" - DocumentType getNodeName - DocumentFragment "#document-fragment" - Element getTagName - ElementDecl getName - EntityReference getEntityName - Entity getNotationName - Notation getName - ProcessingInstruction getTarget - Text "#text" - XMLDecl "#xml-declaration" - -B: AttDef, AttlistDecl, ElementDecl and XMLDecl were added for -completeness. - -=item getNodeValue and setNodeValue (value) - -Returns a string or undef, depending on the node type. This method is provided -for completeness. In other languages it saves the programmer an upcast. -The value is either available thru some other method defined in the subclass, or -else undef is returned. Here are the corresponding methods: -Attr::getValue, Text::getData, CDATASection::getData, Comment::getData, -ProcessingInstruction::getData. - -=item getParentNode and setParentNode (parentNode) - -The parent of this node. All nodes, except Document, -DocumentFragment, and Attr may have a parent. However, if a -node has just been created and not yet added to the tree, or -if it has been removed from the tree, this is undef. - -=item getChildNodes - -A NodeList that contains all children of this node. If there -are no children, this is a NodeList containing no nodes. The -content of the returned NodeList is "live" in the sense that, -for instance, changes to the children of the node object that -it was created from are immediately reflected in the nodes -returned by the NodeList accessors; it is not a static -snapshot of the content of the node. This is true for every -NodeList, including the ones returned by the -getElementsByTagName method. - -NOTE: this implementation does not return a "live" NodeList for -getElementsByTagName. See L. - -When this method is called in a list context, it returns a regular perl list -containing the child nodes. Note that this list is not "live". E.g. - - @list = $node->getChildNodes; # returns a perl list - $nodelist = $node->getChildNodes; # returns a NodeList (object reference) - for my $kid ($node->getChildNodes) # iterate over the children of $node - -=item getFirstChild - -The first child of this node. If there is no such node, this returns undef. - -=item getLastChild - -The last child of this node. If there is no such node, this returns undef. - -=item getPreviousSibling - -The node immediately preceding this node. If there is no such -node, this returns undef. - -=item getNextSibling - -The node immediately following this node. If there is no such node, this returns -undef. - -=item getAttributes - -A NamedNodeMap containing the attributes (Attr nodes) of this node -(if it is an Element) or undef otherwise. -Note that adding/removing attributes from the returned object, also adds/removes -attributes from the Element node that the NamedNodeMap came from. - -=item getOwnerDocument - -The Document object associated with this node. This is also -the Document object used to create new nodes. When this node -is a Document this is undef. - -=item insertBefore (newChild, refChild) - -Inserts the node newChild before the existing child node -refChild. If refChild is undef, insert newChild at the end of -the list of children. - -If newChild is a DocumentFragment object, all of its children -are inserted, in the same order, before refChild. If the -newChild is already in the tree, it is first removed. - -Return Value: The node being inserted. - -DOMExceptions: - -=over 4 - -=item * HIERARCHY_REQUEST_ERR - -Raised if this node is of a type that does not allow children of the type of -the newChild node, or if the node to insert is one of this node's ancestors. - -=item * WRONG_DOCUMENT_ERR - -Raised if newChild was created from a different document than the one that -created this node. - -=item * NO_MODIFICATION_ALLOWED_ERR - -Raised if this node is readonly. - -=item * NOT_FOUND_ERR - -Raised if refChild is not a child of this node. - -=back - -=item replaceChild (newChild, oldChild) - -Replaces the child node oldChild with newChild in the list of -children, and returns the oldChild node. If the newChild is -already in the tree, it is first removed. - -Return Value: The node replaced. - -DOMExceptions: - -=over 4 - -=item * HIERARCHY_REQUEST_ERR - -Raised if this node is of a type that does not allow children of the type of -the newChild node, or it the node to put in is one of this node's ancestors. - -=item * WRONG_DOCUMENT_ERR - -Raised if newChild was created from a different document than the one that -created this node. - -=item * NO_MODIFICATION_ALLOWED_ERR - -Raised if this node is readonly. - -=item * NOT_FOUND_ERR - -Raised if oldChild is not a child of this node. - -=back - -=item removeChild (oldChild) - -Removes the child node indicated by oldChild from the list of -children, and returns it. - -Return Value: The node removed. - -DOMExceptions: - -=over 4 - -=item * NO_MODIFICATION_ALLOWED_ERR - -Raised if this node is readonly. - -=item * NOT_FOUND_ERR - -Raised if oldChild is not a child of this node. - -=back - -=item appendChild (newChild) - -Adds the node newChild to the end of the list of children of -this node. If the newChild is already in the tree, it is -first removed. If it is a DocumentFragment object, the entire contents of -the document fragment are moved into the child list of this node - -Return Value: The node added. - -DOMExceptions: - -=over 4 - -=item * HIERARCHY_REQUEST_ERR - -Raised if this node is of a type that does not allow children of the type of -the newChild node, or if the node to append is one of this node's ancestors. - -=item * WRONG_DOCUMENT_ERR - -Raised if newChild was created from a different document than the one that -created this node. - -=item * NO_MODIFICATION_ALLOWED_ERR - -Raised if this node is readonly. - -=back - -=item hasChildNodes - -This is a convenience method to allow easy determination of -whether a node has any children. - -Return Value: 1 if the node has any children, 0 otherwise. - -=item cloneNode (deep) - -Returns a duplicate of this node, i.e., serves as a generic -copy constructor for nodes. The duplicate node has no parent -(parentNode returns undef.). - -Cloning an Element copies all attributes and their values, -including those generated by the XML processor to represent -defaulted attributes, but this method does not copy any text -it contains unless it is a deep clone, since the text is -contained in a child Text node. Cloning any other type of -node simply returns a copy of this node. - -Parameters: - I If true, recursively clone the subtree under the specified node. -If false, clone only the node itself (and its attributes, if it is an Element). - -Return Value: The duplicate node. - -=item normalize - -Puts all Text nodes in the full depth of the sub-tree -underneath this Element into a "normal" form where only -markup (e.g., tags, comments, processing instructions, CDATA -sections, and entity references) separates Text nodes, i.e., -there are no adjacent Text nodes. This can be used to ensure -that the DOM view of a document is the same as if it were -saved and re-loaded, and is useful when operations (such as -XPointer lookups) that depend on a particular document tree -structure are to be used. - -B: In the DOM Spec this method is defined in the Element and -Document class interfaces only, but it doesn't hurt to have it here... - -=item getElementsByTagName (name [, recurse]) - -Returns a NodeList of all descendant elements with a given -tag name, in the order in which they would be encountered in -a preorder traversal of the Element tree. - -Parameters: - I The name of the tag to match on. The special value "*" matches all tags. - I Whether it should return only direct child nodes (0) or any descendant that matches the tag name (1). This argument is optional and defaults to 1. It is not part of the DOM spec. - -Return Value: A list of matching Element nodes. - -NOTE: this implementation does not return a "live" NodeList for -getElementsByTagName. See L. - -When this method is called in a list context, it returns a regular perl list -containing the result nodes. E.g. - - @list = $node->getElementsByTagName("tag"); # returns a perl list - $nodelist = $node->getElementsByTagName("tag"); # returns a NodeList (object ref.) - for my $elem ($node->getElementsByTagName("tag")) # iterate over the result nodes - -=back - -=head2 Additional methods not in the DOM Spec - -=over 4 - -=item getNodeTypeName - -Return the string describing the node type. -E.g. returns "ELEMENT_NODE" if getNodeType returns ELEMENT_NODE. -It uses @XML::DOM::Node::NodeNames. - -=item toString - -Returns the entire subtree as a string. - -=item printToFile (filename) - -Prints the entire subtree to the file with the specified filename. - -Croaks: if the file could not be opened for writing. - -=item printToFileHandle (handle) - -Prints the entire subtree to the file handle. -E.g. to print to STDOUT: - - $node->printToFileHandle (\*STDOUT); - -=item print (obj) - -Prints the entire subtree using the object's print method. E.g to print to a -FileHandle object: - - $f = new FileHandle ("file.out", "w"); - $node->print ($f); - -=item getChildIndex (child) - -Returns the index of the child node in the list returned by getChildNodes. - -Return Value: the index or -1 if the node is not found. - -=item getChildAtIndex (index) - -Returns the child node at the specified index or undef. - -=item addText (text) - -Appends the specified string to the last child if it is a Text node, or else -appends a new Text node (with the specified text.) - -Return Value: the last child if it was a Text node or else the new Text node. - -=item dispose - -Removes all circular references in this node and its descendants so the -objects can be claimed for garbage collection. The objects should not be used -afterwards. - -=item setOwnerDocument (doc) - -Sets the ownerDocument property of this node and all its children (and -attributes etc.) to the specified document. -This allows the user to cut and paste document subtrees between different -XML::DOM::Documents. The node should be removed from the original document -first, before calling setOwnerDocument. - -This method does nothing when called on a Document node. - -=item isAncestor (parent) - -Returns 1 if parent is an ancestor of this node or if it is this node itself. - -=item expandEntityRefs (str) - -Expands all the entity references in the string and returns the result. -The entity references can be character references (e.g. "{" or "ῂ"), -default entity references (""", ">", "<", "'" and "&") or -entity references defined in Entity objects as part of the DocumentType of -the owning Document. Character references are expanded into UTF-8. -Parameter entity references (e.g. %ent;) are not expanded. - -=item to_sax ( %HANDLERS ) - -E.g. - - $node->to_sax (DocumentHandler => $my_handler, - Handler => $handler2 ); - -%HANDLERS may contain the following handlers: - -=over 4 - -=item * DocumentHandler - -=item * DTDHandler - -=item * EntityResolver - -=item * Handler - -Default handler when one of the above is not specified - -=back - -Each XML::DOM::Node generates the appropriate SAX callbacks (for the -appropriate SAX handler.) Different SAX handlers can be plugged in to -accomplish different things, e.g. L would check the node -(currently only Document and Element nodes are supported), L -would create a new DOM subtree (thereby, in essence, copying the Node) -and in the near future, XML::Writer could print the node. -All Perl SAX related work is still in flux, so this interface may change a -little. - -See PerlSAX for the description of the SAX interface. - -=item check ( [$checker] ) - -See descriptions for check() in L and L. - -=item xql ( @XQL_OPTIONS ) - -To use the xql method, you must first I L and L. -This method is basically a shortcut for: - - $query = new XML::XQL::Query ( @XQL_OPTIONS ); - return $query->solve ($node); - -If the first parameter in @XQL_OPTIONS is the XQL expression, you can leave off -the 'Expr' keyword, so: - - $node->xql ("doc//elem1[@attr]", @other_options); - -is identical to: - - $node->xql (Expr => "doc//elem1[@attr]", @other_options); - -See L for other available XQL_OPTIONS. -See L and L for more info. - -=item isHidden () - -Whether the node is hidden. -See L for details. - -=back diff --git a/perl_lib/XML/DOM/NodeList.pm b/perl_lib/XML/DOM/NodeList.pm deleted file mode 100644 index 9e40760..0000000 --- a/perl_lib/XML/DOM/NodeList.pm +++ /dev/null @@ -1,83 +0,0 @@ -=head1 NAME - -XML::DOM::NodeList - -=cut - -###################################################################### -package XML::DOM::NodeList; -###################################################################### - -use vars qw ( $EMPTY ); - -# Empty NodeList -$EMPTY = new XML::DOM::NodeList; - -sub new -{ - bless [], $_[0]; -} - -sub item -{ - $_[0]->[$_[1]]; -} - -sub getLength -{ - int (@{$_[0]}); -} - -#------------------------------------------------------------ -# Extra method implementations - -sub dispose -{ - my $self = shift; - for my $kid (@{$self}) - { - $kid->dispose; - } -} - -sub setOwnerDocument -{ - my ($self, $doc) = @_; - for my $kid (@{$self}) - { - $kid->setOwnerDocument ($doc); - } -} - -1; # package return code - -=head1 COPYRIGHT - -=for COPYRIGHT BEGIN - -Copyright 2022 University of Southampton. -EPrints 3.4 is supplied by EPrints Services. - -http://www.eprints.org/eprints-3.4/ - -=for COPYRIGHT END - -=for LICENSE BEGIN - -This file is part of EPrints 3.4 L. - -EPrints 3.4 and this file are released under the terms of the -GNU Lesser General Public License version 3 as published by -the Free Software Foundation unless otherwise stated. - -EPrints 3.4 is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -See the GNU Lesser General Public License for more details. - -You should have received a copy of the GNU Lesser General Public -License along with EPrints 3.4. -If not, see L. - -=for LICENSE END - diff --git a/perl_lib/XML/DOM/NodeList.pod b/perl_lib/XML/DOM/NodeList.pod deleted file mode 100644 index f956308..0000000 --- a/perl_lib/XML/DOM/NodeList.pod +++ /dev/null @@ -1,46 +0,0 @@ -=head1 NAME - -XML::DOM::NodeList - A node list as used by XML::DOM - -=head1 DESCRIPTION - -The NodeList interface provides the abstraction of an ordered -collection of nodes, without defining or constraining how this -collection is implemented. - -The items in the NodeList are accessible via an integral index, -starting from 0. - -Although the DOM spec states that all NodeLists are "live" in that they -always reflect changes to the DOM tree, the NodeList returned by -getElementsByTagName is not live in this implementation. See L -for details. - -=head2 METHODS - -=over 4 - -=item item (index) - -Returns the indexth item in the collection. If index is -greater than or equal to the number of nodes in the list, -this returns undef. - -=item getLength - -The number of nodes in the list. The range of valid child -node indices is 0 to length-1 inclusive. - -=back - -=head2 Additional methods not in the DOM Spec - -=over 4 - -=item dispose - -Removes all circular references in this NodeList and its descendants so the -objects can be claimed for garbage collection. The objects should not be used -afterwards. - -=back diff --git a/perl_lib/XML/DOM/Notation.pod b/perl_lib/XML/DOM/Notation.pod deleted file mode 100644 index e197a17..0000000 --- a/perl_lib/XML/DOM/Notation.pod +++ /dev/null @@ -1,47 +0,0 @@ -=head1 NAME - -XML::DOM::Notation - An XML NOTATION in XML::DOM - -=head1 DESCRIPTION - -XML::DOM::Notation extends L. - -This node represents a Notation, e.g. - - - - - - - - - -=head2 METHODS - -=over 4 - -=item getName and setName (name) - -Returns (or sets) the Notation name, which is the first token after the -NOTATION keyword. - -=item getSysId and setSysId (sysId) - -Returns (or sets) the system ID, which is the token after the optional -SYSTEM keyword. - -=item getPubId and setPubId (pubId) - -Returns (or sets) the public ID, which is the token after the optional -PUBLIC keyword. - -=item getBase - -This is passed by XML::Parser in the Notation handler. -I don't know what it is yet. - -=item getNodeName - -Returns the same as getName. - -=back diff --git a/perl_lib/XML/DOM/Parser.pod b/perl_lib/XML/DOM/Parser.pod deleted file mode 100644 index ce98d30..0000000 --- a/perl_lib/XML/DOM/Parser.pod +++ /dev/null @@ -1,66 +0,0 @@ -=head1 NAME - -XML::DOM::Parser - An XML::Parser that builds XML::DOM document structures - -=head1 SYNOPSIS - - use XML::DOM; - - my $parser = new XML::DOM::Parser; - my $doc = $parser->parsefile ("file.xml"); - -=head1 DESCRIPTION - -XML::DOM::Parser extends L - -The XML::Parser module was written by Clark Cooper and -is built on top of XML::Parser::Expat, -which is a lower level interface to James Clark's expat library. - -XML::DOM::Parser parses XML strings or files -and builds a data structure that conforms to the API of the Document Object -Model as described at L. -See the L manpage for other additional properties of the -XML::DOM::Parser class. -Note that the 'Style' property should not be used (it is set internally.) - -The XML::Parser B option is more or less supported, in that it will -generate EntityReference objects whenever an entity reference is encountered -in character data. I'm not sure how useful this is. Any comments are welcome. - -As described in the synopsis, when you create an XML::DOM::Parser object, -the parse and parsefile methods create an L object -from the specified input. This Document object can then be examined, modified and -written back out to a file or converted to a string. - -When using XML::DOM with XML::Parser version 2.19 and up, setting the -XML::DOM::Parser option B to 1 will store CDATASections in -CDATASection nodes, instead of converting them to Text nodes. -Subsequent CDATASection nodes will be merged into one. Let me know if this -is a problem. - -=head1 Using LWP to parse URLs - -The parsefile() method now also supports URLs, e.g. I. -It uses LWP to download the file and then calls parse() on the resulting string. -By default it will use a L that is created as follows: - - use LWP::UserAgent; - $LWP_USER_AGENT = LWP::UserAgent->new; - $LWP_USER_AGENT->env_proxy; - -Note that env_proxy reads proxy settings from environment variables, which is what I need to -do to get thru our firewall. If you want to use a different LWP::UserAgent, you can either set -it globally with: - - XML::DOM::Parser::set_LWP_UserAgent ($my_agent); - -or, you can specify it for a specific XML::DOM::Parser by passing it to the constructor: - - my $parser = new XML::DOM::Parser (LWP_UserAgent => $my_agent); - -Currently, LWP is used when the filename (passed to parsefile) starts with one of -the following URL schemes: http, https, ftp, wais, gopher, or file (followed by a colon.) -If I missed one, please let me know. - -The LWP modules are part of libwww-perl which is available at CPAN. diff --git a/perl_lib/XML/DOM/PerlSAX.pm b/perl_lib/XML/DOM/PerlSAX.pm deleted file mode 100644 index a6d7fc8..0000000 --- a/perl_lib/XML/DOM/PerlSAX.pm +++ /dev/null @@ -1,79 +0,0 @@ -package XML::DOM::PerlSAX; -use strict; - -BEGIN -{ - if ($^W) - { - warn "XML::DOM::PerlSAX has been renamed to XML::Handler::DOM, " - "please modify your code accordingly."; - } -} - -use XML::Handler::DOM; -use vars qw{ @ISA }; -@ISA = qw{ XML::Handler::DOM }; - -1; # package return code - -__END__ - -=head1 NAME - -XML::DOM::PerlSAX - Old name of L - -=head1 SYNOPSIS - - See L - -=head1 DESCRIPTION - -XML::DOM::PerlSAX was renamed to L to comply -with naming conventions for PerlSAX filters/handlers. - -For backward compatibility, this package will remain in existence -(it simply includes XML::Handler::BuildDOM), but it will print a warning when -running with I<'perl -w'>. - -=head1 AUTHOR - -Enno Derksen is the original author. - -Send bug reports, hints, tips, suggestions to T.J Mather at ->. - -=head1 SEE ALSO - -L, L - - -=head1 COPYRIGHT - -=for COPYRIGHT BEGIN - -Copyright 2022 University of Southampton. -EPrints 3.4 is supplied by EPrints Services. - -http://www.eprints.org/eprints-3.4/ - -=for COPYRIGHT END - -=for LICENSE BEGIN - -This file is part of EPrints 3.4 L. - -EPrints 3.4 and this file are released under the terms of the -GNU Lesser General Public License version 3 as published by -the Free Software Foundation unless otherwise stated. - -EPrints 3.4 is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -See the GNU Lesser General Public License for more details. - -You should have received a copy of the GNU Lesser General Public -License along with EPrints 3.4. -If not, see L. - -=for LICENSE END - diff --git a/perl_lib/XML/DOM/ProcessingInstruction.pod b/perl_lib/XML/DOM/ProcessingInstruction.pod deleted file mode 100644 index 9bedf17..0000000 --- a/perl_lib/XML/DOM/ProcessingInstruction.pod +++ /dev/null @@ -1,32 +0,0 @@ -=head1 NAME - -XML::DOM::ProcessingInstruction - An XML processing instruction in XML::DOM - -=head1 DESCRIPTION - -XML::DOM::ProcessingInstruction extends L. - -It represents a "processing instruction", used in XML as a way to keep -processor-specific information in the text of the document. An example: - - - -Here, "PI" is the target and "processing instruction" is the data. - -=head2 METHODS - -=over 4 - -=item getTarget - -The target of this processing instruction. XML defines this -as being the first token following the markup that begins the -processing instruction. - -=item getData and setData (data) - -The content of this processing instruction. This is from the -first non white space character after the target to the -character immediately preceding the ?>. - -=back diff --git a/perl_lib/XML/DOM/Text.pod b/perl_lib/XML/DOM/Text.pod deleted file mode 100644 index b86f1ea..0000000 --- a/perl_lib/XML/DOM/Text.pod +++ /dev/null @@ -1,60 +0,0 @@ -=head1 NAME - -XML::DOM::Text - A piece of XML text in XML::DOM - -=head1 DESCRIPTION - -XML::DOM::Text extends L, which extends -L. - -The Text interface represents the textual content (termed character -data in XML) of an Element or Attr. If there is no markup inside an -element's content, the text is contained in a single object -implementing the Text interface that is the only child of the element. -If there is markup, it is parsed into a list of elements and Text nodes -that form the list of children of the element. - -When a document is first made available via the DOM, there is only one -Text node for each block of text. Users may create adjacent Text nodes -that represent the contents of a given element without any intervening -markup, but should be aware that there is no way to represent the -separations between these nodes in XML or HTML, so they will not (in -general) persist between DOM editing sessions. The normalize() method -on Element merges any such adjacent Text objects into a single node for -each block of text; this is recommended before employing operations -that depend on a particular document structure, such as navigation with -XPointers. - -=head2 METHODS - -=over 4 - -=item splitText (offset) - -Breaks this Text node into two Text nodes at the specified -offset, keeping both in the tree as siblings. This node then -only contains all the content up to the offset point. And a -new Text node, which is inserted as the next sibling of this -node, contains all the content at and after the offset point. - -Parameters: - I The offset at which to split, starting from 0. - -Return Value: The new Text node. - -DOMExceptions: - -=over 4 - -=item * INDEX_SIZE_ERR - -Raised if the specified offset is negative or greater than the number of -characters in data. - -=item * NO_MODIFICATION_ALLOWED_ERR - -Raised if this node is readonly. - -=back - -=back diff --git a/perl_lib/XML/DOM/XMLDecl.pod b/perl_lib/XML/DOM/XMLDecl.pod deleted file mode 100644 index f6e6a3a..0000000 --- a/perl_lib/XML/DOM/XMLDecl.pod +++ /dev/null @@ -1,33 +0,0 @@ -=head1 NAME - -XML::DOM::XMLDecl - XML declaration in XML::DOM - -=head1 DESCRIPTION - -XML::DOM::XMLDecl extends L, but is not part of the DOM Level 1 -specification. - -It contains the XML declaration, e.g. - - - -See also XML::DOM::Document::getXMLDecl. - -=head2 METHODS - -=over 4 - -=item getVersion and setVersion (version) - -Returns and sets the XML version. At the time of this writing the version should -always be "1.0" - -=item getEncoding and setEncoding (encoding) - -undef may be specified for the encoding value. - -=item getStandalone and setStandalone (standalone) - -undef may be specified for the standalone value. - -=back diff --git a/perl_lib/XML/NamespaceSupport.pm b/perl_lib/XML/NamespaceSupport.pm deleted file mode 100644 index fc2ad67..0000000 --- a/perl_lib/XML/NamespaceSupport.pm +++ /dev/null @@ -1,583 +0,0 @@ - -### -# XML::NamespaceSupport - a simple generic namespace processor -# Robin Berjon -### - -package XML::NamespaceSupport; -use strict; -use constant FATALS => 0; # root object -use constant NSMAP => 1; -use constant UNKNOWN_PREF => 2; -use constant AUTO_PREFIX => 3; -use constant XMLNS_11 => 4; -use constant DEFAULT => 0; # maps -use constant PREFIX_MAP => 1; -use constant DECLARATIONS => 2; - -use vars qw($VERSION $NS_XMLNS $NS_XML); -$VERSION = '1.11'; -$NS_XMLNS = 'http://www.w3.org/2000/xmlns/'; -$NS_XML = 'http://www.w3.org/XML/1998/namespace'; - - -# add the ns stuff that baud wants based on Java's xml-writer - - -#-------------------------------------------------------------------# -# constructor -#-------------------------------------------------------------------# -sub new { - my $class = ref($_[0]) ? ref(shift) : shift; - my $options = shift; - my $self = [ - 1, # FATALS - [[ # NSMAP - undef, # DEFAULT - { xml => $NS_XML }, # PREFIX_MAP - undef, # DECLARATIONS - ]], - 'aaa', # UNKNOWN_PREF - 0, # AUTO_PREFIX - 1, # XML_11 - ]; - $self->[NSMAP]->[0]->[PREFIX_MAP]->{xmlns} = $NS_XMLNS if $options->{xmlns}; - $self->[FATALS] = $options->{fatal_errors} if defined $options->{fatal_errors}; - $self->[AUTO_PREFIX] = $options->{auto_prefix} if defined $options->{auto_prefix}; - $self->[XMLNS_11] = $options->{xmlns_11} if defined $options->{xmlns_11}; - return bless $self, $class; -} -#-------------------------------------------------------------------# - -#-------------------------------------------------------------------# -# reset() - return to the original state (for reuse) -#-------------------------------------------------------------------# -sub reset { - my $self = shift; - $#{$self->[NSMAP]} = 0; -} -#-------------------------------------------------------------------# - -#-------------------------------------------------------------------# -# push_context() - add a new empty context to the stack -#-------------------------------------------------------------------# -sub push_context { - my $self = shift; - push @{$self->[NSMAP]}, [ - $self->[NSMAP]->[-1]->[DEFAULT], - { %{$self->[NSMAP]->[-1]->[PREFIX_MAP]} }, - [], - ]; -} -#-------------------------------------------------------------------# - -#-------------------------------------------------------------------# -# pop_context() - remove the topmost context from the stack -#-------------------------------------------------------------------# -sub pop_context { - my $self = shift; - die 'Trying to pop context without push context' unless @{$self->[NSMAP]} > 1; - pop @{$self->[NSMAP]}; -} -#-------------------------------------------------------------------# - -#-------------------------------------------------------------------# -# declare_prefix() - declare a prefix in the current scope -#-------------------------------------------------------------------# -sub declare_prefix { - my $self = shift; - my $prefix = shift; - my $value = shift; - - warn <<' EOWARN' unless defined $prefix or $self->[AUTO_PREFIX]; - Prefix was undefined. - If you wish to set the default namespace, use the empty string ''. - If you wish to autogenerate prefixes, set the auto_prefix option - to a true value. - EOWARN - - no warnings 'uninitialized'; - if ($prefix eq 'xml' and $value ne $NS_XML) { - die "The xml prefix can only be bound to the $NS_XML namespace." - } - elsif ($value eq $NS_XML and $prefix ne 'xml') { - die "the $NS_XML namespace can only be bound to the xml prefix."; - } - elsif ($value eq $NS_XML and $prefix eq 'xml') { - return 1; - } - return 0 if index(lc($prefix), 'xml') == 0; - use warnings 'uninitialized'; - - if (defined $prefix and $prefix eq '') { - $self->[NSMAP]->[-1]->[DEFAULT] = $value; - } - else { - die "Cannot undeclare prefix $prefix" if $value eq '' and not $self->[XMLNS_11]; - if (not defined $prefix and $self->[AUTO_PREFIX]) { - while (1) { - $prefix = $self->[UNKNOWN_PREF]++; - last if not exists $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix}; - } - } - elsif (not defined $prefix and not $self->[AUTO_PREFIX]) { - return 0; - } - $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix} = $value; - } - push @{$self->[NSMAP]->[-1]->[DECLARATIONS]}, $prefix; - return 1; -} -#-------------------------------------------------------------------# - -#-------------------------------------------------------------------# -# declare_prefixes() - declare several prefixes in the current scope -#-------------------------------------------------------------------# -sub declare_prefixes { - my $self = shift; - my %prefixes = @_; - while (my ($k,$v) = each %prefixes) { - $self->declare_prefix($k,$v); - } -} -#-------------------------------------------------------------------# - -#-------------------------------------------------------------------# -# undeclare_prefix -#-------------------------------------------------------------------# -sub undeclare_prefix { - my $self = shift; - my $prefix = shift; - return unless not defined $prefix or $prefix eq ''; - return unless exists $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix}; - - my ( $tfix ) = grep { $_ eq $prefix } @{$self->[NSMAP]->[-1]->[DECLARATIONS]}; - if ( not defined $tfix ) { - die "prefix $prefix not declared in this context\n"; - } - - @{$self->[NSMAP]->[-1]->[DECLARATIONS]} = grep { $_ ne $prefix } @{$self->[NSMAP]->[-1]->[DECLARATIONS]}; - delete $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix}; -} -#-------------------------------------------------------------------# - -#-------------------------------------------------------------------# -# get_prefix() - get a (random) prefix for a given URI -#-------------------------------------------------------------------# -sub get_prefix { - my $self = shift; - my $uri = shift; - - # we have to iterate over the whole hash here because if we don't - # the iterator isn't reset and the next pass will fail - my $pref; - while (my ($k, $v) = each %{$self->[NSMAP]->[-1]->[PREFIX_MAP]}) { - $pref = $k if $v eq $uri; - } - return $pref; -} -#-------------------------------------------------------------------# - -#-------------------------------------------------------------------# -# get_prefixes() - get all the prefixes for a given URI -#-------------------------------------------------------------------# -sub get_prefixes { - my $self = shift; - my $uri = shift; - - return keys %{$self->[NSMAP]->[-1]->[PREFIX_MAP]} unless defined $uri; - return grep { $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$_} eq $uri } keys %{$self->[NSMAP]->[-1]->[PREFIX_MAP]}; -} -#-------------------------------------------------------------------# - -#-------------------------------------------------------------------# -# get_declared_prefixes() - get all prefixes declared in the last context -#-------------------------------------------------------------------# -sub get_declared_prefixes { - return @{$_[0]->[NSMAP]->[-1]->[DECLARATIONS]}; -} -#-------------------------------------------------------------------# - -#-------------------------------------------------------------------# -# get_uri() - get an URI given a prefix -#-------------------------------------------------------------------# -sub get_uri { - my $self = shift; - my $prefix = shift; - - warn "Prefix must not be undef in get_uri(). The empty prefix must be ''" unless defined $prefix; - - return $self->[NSMAP]->[-1]->[DEFAULT] if $prefix eq ''; - return $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix} if exists $self->[NSMAP]->[-1]->[PREFIX_MAP]->{$prefix}; - return undef; -} -#-------------------------------------------------------------------# - -#-------------------------------------------------------------------# -# process_name() - provide details on a name -#-------------------------------------------------------------------# -sub process_name { - my $self = shift; - my $qname = shift; - my $aflag = shift; - - if ($self->[FATALS]) { - return( ($self->_get_ns_details($qname, $aflag))[0,2], $qname ); - } - else { - eval { return( ($self->_get_ns_details($qname, $aflag))[0,2], $qname ); } - } -} -#-------------------------------------------------------------------# - -#-------------------------------------------------------------------# -# process_element_name() - provide details on a element's name -#-------------------------------------------------------------------# -sub process_element_name { - my $self = shift; - my $qname = shift; - - if ($self->[FATALS]) { - return $self->_get_ns_details($qname, 0); - } - else { - eval { return $self->_get_ns_details($qname, 0); } - } -} -#-------------------------------------------------------------------# - - -#-------------------------------------------------------------------# -# process_attribute_name() - provide details on a attribute's name -#-------------------------------------------------------------------# -sub process_attribute_name { - my $self = shift; - my $qname = shift; - - if ($self->[FATALS]) { - return $self->_get_ns_details($qname, 1); - } - else { - eval { return $self->_get_ns_details($qname, 1); } - } -} -#-------------------------------------------------------------------# - - -#-------------------------------------------------------------------# -# ($ns, $prefix, $lname) = $self->_get_ns_details($qname, $f_attr) -# returns ns, prefix, and lname for a given attribute name -# >> the $f_attr flag, if set to one, will work for an attribute -#-------------------------------------------------------------------# -sub _get_ns_details { - my $self = shift; - my $qname = shift; - my $aflag = shift; - - my ($ns, $prefix, $lname); - (my ($tmp_prefix, $tmp_lname) = split /:/, $qname, 3) - < 3 or die "Invalid QName: $qname"; - - # no prefix - my $cur_map = $self->[NSMAP]->[-1]; - if (not defined($tmp_lname)) { - $prefix = undef; - $lname = $qname; - # attr don't have a default namespace - $ns = ($aflag) ? undef : $cur_map->[DEFAULT]; - } - - # prefix - else { - if (exists $cur_map->[PREFIX_MAP]->{$tmp_prefix}) { - $prefix = $tmp_prefix; - $lname = $tmp_lname; - $ns = $cur_map->[PREFIX_MAP]->{$prefix} - } - else { # no ns -> lname == name, all rest undef - die "Undeclared prefix: $tmp_prefix"; - } - } - - return ($ns, $prefix, $lname); -} -#-------------------------------------------------------------------# - -#-------------------------------------------------------------------# -# parse_jclark_notation() - parse the Clarkian notation -#-------------------------------------------------------------------# -sub parse_jclark_notation { - shift; - my $jc = shift; - $jc =~ m/^\{(.*)\}([^}]+)$/; - return $1, $2; -} -#-------------------------------------------------------------------# - - -#-------------------------------------------------------------------# -# Java names mapping -#-------------------------------------------------------------------# -*XML::NamespaceSupport::pushContext = \&push_context; -*XML::NamespaceSupport::popContext = \&pop_context; -*XML::NamespaceSupport::declarePrefix = \&declare_prefix; -*XML::NamespaceSupport::declarePrefixes = \&declare_prefixes; -*XML::NamespaceSupport::getPrefix = \&get_prefix; -*XML::NamespaceSupport::getPrefixes = \&get_prefixes; -*XML::NamespaceSupport::getDeclaredPrefixes = \&get_declared_prefixes; -*XML::NamespaceSupport::getURI = \&get_uri; -*XML::NamespaceSupport::processName = \&process_name; -*XML::NamespaceSupport::processElementName = \&process_element_name; -*XML::NamespaceSupport::processAttributeName = \&process_attribute_name; -*XML::NamespaceSupport::parseJClarkNotation = \&parse_jclark_notation; -*XML::NamespaceSupport::undeclarePrefix = \&undeclare_prefix; -#-------------------------------------------------------------------# - - -1; -#,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,# -#`,`, Documentation `,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,# -#```````````````````````````````````````````````````````````````````# - -=pod - -=head1 NAME - -XML::NamespaceSupport - a simple generic namespace support class - -=head1 SYNOPSIS - - use XML::NamespaceSupport; - my $nsup = XML::NamespaceSupport->new; - - # add a new empty context - $nsup->push_context; - # declare a few prefixes - $nsup->declare_prefix($prefix1, $uri1); - $nsup->declare_prefix($prefix2, $uri2); - # the same shorter - $nsup->declare_prefixes($prefix1 => $uri1, $prefix2 => $uri2); - - # get a single prefix for a URI (randomly) - $prefix = $nsup->get_prefix($uri); - # get all prefixes for a URI (probably better) - @prefixes = $nsup->get_prefixes($uri); - # get all prefixes in scope - @prefixes = $nsup->get_prefixes(); - # get all prefixes that were declared for the current scope - @prefixes = $nsup->get_declared_prefixes; - # get a URI for a given prefix - $uri = $nsup->get_uri($prefix); - - # get info on a qname (java-ish way, it's a bit weird) - ($ns_uri, $local_name, $qname) = $nsup->process_name($qname, $is_attr); - # the same, more perlish - ($ns_uri, $prefix, $local_name) = $nsup->process_element_name($qname); - ($ns_uri, $prefix, $local_name) = $nsup->process_attribute_name($qname); - - # remove the current context - $nsup->pop_context; - - # reset the object for reuse in another document - $nsup->reset; - - # a simple helper to process Clarkian Notation - my ($ns, $lname) = $nsup->parse_jclark_notation('{http://foo}bar'); - # or (given that it doesn't care about the object - my ($ns, $lname) = XML::NamespaceSupport->parse_jclark_notation('{http://foo}bar'); - - -=head1 DESCRIPTION - -This module offers a simple to process namespaced XML names (unames) -from within any application that may need them. It also helps maintain -a prefix to namespace URI map, and provides a number of basic checks. - -The model for this module is SAX2's NamespaceSupport class, readable at -http://www.megginson.com/SAX/Java/javadoc/org/xml/sax/helpers/NamespaceSupport.html. -It adds a few perlisations where we thought it appropriate. - -=head1 METHODS - -=over 4 - -=item * XML::NamespaceSupport->new(\%options) - -A simple constructor. - -The options are C, C, and C - -If C is turned on (it is off by default) the mapping from the -xmlns prefix to the URI defined for it in DOM level 2 is added to the -list of predefined mappings (which normally only contains the xml -prefix mapping). - -If C is turned off (it is on by default) a number of -validity errors will simply be flagged as failures, instead of -die()ing. - -If C is turned on (it is off by default) when one -provides a prefix of C to C it will generate a -random prefix mapped to that namespace. Otherwise an undef prefix will -trigger a warning (you should probably know what you're doing if you -turn this option on). - -If C us turned off, it becomes illegal to undeclare namespace -prefixes. It is on by default. This behaviour is compliant with Namespaces -in XML 1.1, turning it off reverts you to version 1.0. - -=item * $nsup->push_context - -Adds a new empty context to the stack. You can then populate it with -new prefixes defined at this level. - -=item * $nsup->pop_context - -Removes the topmost context in the stack and reverts to the previous -one. It will die() if you try to pop more than you have pushed. - -=item * $nsup->declare_prefix($prefix, $uri) - -Declares a mapping of $prefix to $uri, at the current level. - -Note that with C turned on, if you declare a prefix -mapping in which $prefix is undef(), you will get an automatic prefix -selected for you. If it is off you will get a warning. - -This is useful when you deal with code that hasn't kept prefixes around -and need to reserialize the nodes. It also means that if you want to -set the default namespace (ie with an empty prefix) you must use the -empty string instead of undef. This behaviour is consistent with the -SAX 2.0 specification. - -=item * $nsup->declare_prefixes(%prefixes2uris) - -Declares a mapping of several prefixes to URIs, at the current level. - -=item * $nsup->get_prefix($uri) - -Returns a prefix given an URI. Note that as several prefixes may be -mapped to the same URI, it returns an arbitrary one. It'll return -undef on failure. - -=item * $nsup->get_prefixes($uri) - -Returns an array of prefixes given an URI. It'll return all the -prefixes if the uri is undef. - -=item * $nsup->get_declared_prefixes - -Returns an array of all the prefixes that have been declared within -this context, ie those that were declared on the last element, not -those that were declared above and are simply in scope. - -=item * $nsup->get_uri($prefix) - -Returns a URI for a given prefix. Returns undef on failure. - -=item * $nsup->process_name($qname, $is_attr) - -Given a qualified name and a boolean indicating whether this is an -attribute or another type of name (those are differently affected by -default namespaces), it returns a namespace URI, local name, qualified -name tuple. I know that that is a rather abnormal list to return, but -it is so for compatibility with the Java spec. See below for more -Perlish alternatives. - -If the prefix is not declared, or if the name is not valid, it'll -either die or return undef depending on the current setting of -C. - -=item * $nsup->undeclare_prefix($prefix); - -Removes a namespace prefix from the current context. This function may -be used in SAX's end_prefix_mapping when there is fear that a namespace -declaration might be available outside their scope (which shouldn't -normally happen, but you never know ;). This may be needed in order to -properly support Namespace 1.1. - -=item * $nsup->process_element_name($qname) - -Given a qualified name, it returns a namespace URI, prefix, and local -name tuple. This method applies to element names. - -If the prefix is not declared, or if the name is not valid, it'll -either die or return undef depending on the current setting of -C. - -=item * $nsup->process_attribute_name($qname) - -Given a qualified name, it returns a namespace URI, prefix, and local -name tuple. This method applies to attribute names. - -If the prefix is not declared, or if the name is not valid, it'll -either die or return undef depending on the current setting of -C. - -=item * $nsup->reset - -Resets the object so that it can be reused on another document. - -=back - -All methods of the interface have an alias that is the name used in -the original Java specification. You can use either name -interchangeably. Here is the mapping: - - Java name Perl name - --------------------------------------------------- - pushContext push_context - popContext pop_context - declarePrefix declare_prefix - declarePrefixes declare_prefixes - getPrefix get_prefix - getPrefixes get_prefixes - getDeclaredPrefixes get_declared_prefixes - getURI get_uri - processName process_name - processElementName process_element_name - processAttributeName process_attribute_name - parseJClarkNotation parse_jclark_notation - undeclarePrefix undeclare_prefix - -=head1 VARIABLES - -Two global variables are made available to you. They used to be constants but -simple scalars are easier to use in a number of contexts. They are not -exported but can easily be accessed from any package, or copied into it. - -=over 4 - -=item * C<$NS_XMLNS> - -The namespace for xmlns prefixes, http://www.w3.org/2000/xmlns/. - -=item * C<$NS_XML> - -The namespace for xml prefixes, http://www.w3.org/XML/1998/namespace. - -=back - -=head1 TODO - - - add more tests - - optimise here and there - -=head1 AUTHOR - -Robin Berjon, robin@knowscape.com, with lots of it having been done -by Duncan Cameron, and a number of suggestions from the perl-xml -list. - -=head1 COPYRIGHT - -Copyright (c) 2001-2005 Robin Berjon. All rights reserved. This program is -free software; you can redistribute it and/or modify it under the same terms -as Perl itself. - -=head1 SEE ALSO - -XML::Parser::PerlSAX - -=cut - diff --git a/perl_lib/XML/RegExp.pm b/perl_lib/XML/RegExp.pm deleted file mode 100644 index 65434a9..0000000 --- a/perl_lib/XML/RegExp.pm +++ /dev/null @@ -1,113 +0,0 @@ -package XML::RegExp; - -use vars qw( $BaseChar $Ideographic $Letter $Digit $Extender - $CombiningChar $NameChar - $EntityRef $CharRef $Reference - $Name $NmToken $AttValue - $NCNameChar $NCName $Prefix $LocalPart $QName - $VERSION ); - -$VERSION = '0.02'; - -$BaseChar = '(?:[a-zA-Z]|\xC3[\x80-\x96\x98-\xB6\xB8-\xBF]|\xC4[\x80-\xB1\xB4-\xBE]|\xC5[\x81-\x88\x8A-\xBE]|\xC6[\x80-\xBF]|\xC7[\x80-\x83\x8D-\xB0\xB4\xB5\xBA-\xBF]|\xC8[\x80-\x97]|\xC9[\x90-\xBF]|\xCA[\x80-\xA8\xBB-\xBF]|\xCB[\x80\x81]|\xCE[\x86\x88-\x8A\x8C\x8E-\xA1\xA3-\xBF]|\xCF[\x80-\x8E\x90-\x96\x9A\x9C\x9E\xA0\xA2-\xB3]|\xD0[\x81-\x8C\x8E-\xBF]|\xD1[\x80-\x8F\x91-\x9C\x9E-\xBF]|\xD2[\x80\x81\x90-\xBF]|\xD3[\x80-\x84\x87\x88\x8B\x8C\x90-\xAB\xAE-\xB5\xB8\xB9]|\xD4[\xB1-\xBF]|\xD5[\x80-\x96\x99\xA1-\xBF]|\xD6[\x80-\x86]|\xD7[\x90-\xAA\xB0-\xB2]|\xD8[\xA1-\xBA]|\xD9[\x81-\x8A\xB1-\xBF]|\xDA[\x80-\xB7\xBA-\xBE]|\xDB[\x80-\x8E\x90-\x93\x95\xA5\xA6]|\xE0(?:\xA4[\x85-\xB9\xBD]|\xA5[\x98-\xA1]|\xA6[\x85-\x8C\x8F\x90\x93-\xA8\xAA-\xB0\xB2\xB6-\xB9]|\xA7[\x9C\x9D\x9F-\xA1\xB0\xB1]|\xA8[\x85-\x8A\x8F\x90\x93-\xA8\xAA-\xB0\xB2\xB3\xB5\xB6\xB8\xB9]|\xA9[\x99-\x9C\x9E\xB2-\xB4]|\xAA[\x85-\x8B\x8D\x8F-\x91\x93-\xA8\xAA-\xB0\xB2\xB3\xB5-\xB9\xBD]|\xAB\xA0|\xAC[\x85-\x8C\x8F\x90\x93-\xA8\xAA-\xB0\xB2\xB3\xB6-\xB9\xBD]|\xAD[\x9C\x9D\x9F-\xA1]|\xAE[\x85-\x8A\x8E-\x90\x92-\x95\x99\x9A\x9C\x9E\x9F\xA3\xA4\xA8-\xAA\xAE-\xB5\xB7-\xB9]|\xB0[\x85-\x8C\x8E-\x90\x92-\xA8\xAA-\xB3\xB5-\xB9]|\xB1[\xA0\xA1]|\xB2[\x85-\x8C\x8E-\x90\x92-\xA8\xAA-\xB3\xB5-\xB9]|\xB3[\x9E\xA0\xA1]|\xB4[\x85-\x8C\x8E-\x90\x92-\xA8\xAA-\xB9]|\xB5[\xA0\xA1]|\xB8[\x81-\xAE\xB0\xB2\xB3]|\xB9[\x80-\x85]|\xBA[\x81\x82\x84\x87\x88\x8A\x8D\x94-\x97\x99-\x9F\xA1-\xA3\xA5\xA7\xAA\xAB\xAD\xAE\xB0\xB2\xB3\xBD]|\xBB[\x80-\x84]|\xBD[\x80-\x87\x89-\xA9])|\xE1(?:\x82[\xA0-\xBF]|\x83[\x80-\x85\x90-\xB6]|\x84[\x80\x82\x83\x85-\x87\x89\x8B\x8C\x8E-\x92\xBC\xBE]|\x85[\x80\x8C\x8E\x90\x94\x95\x99\x9F-\xA1\xA3\xA5\xA7\xA9\xAD\xAE\xB2\xB3\xB5]|\x86[\x9E\xA8\xAB\xAE\xAF\xB7\xB8\xBA\xBC-\xBF]|\x87[\x80-\x82\xAB\xB0\xB9]|[\xB8\xB9][\x80-\xBF]|\xBA[\x80-\x9B\xA0-\xBF]|\xBB[\x80-\xB9]|\xBC[\x80-\x95\x98-\x9D\xA0-\xBF]|\xBD[\x80-\x85\x88-\x8D\x90-\x97\x99\x9B\x9D\x9F-\xBD]|\xBE[\x80-\xB4\xB6-\xBC\xBE]|\xBF[\x82-\x84\x86-\x8C\x90-\x93\x96-\x9B\xA0-\xAC\xB2-\xB4\xB6-\xBC])|\xE2(?:\x84[\xA6\xAA\xAB\xAE]|\x86[\x80-\x82])|\xE3(?:\x81[\x81-\xBF]|\x82[\x80-\x94\xA1-\xBF]|\x83[\x80-\xBA]|\x84[\x85-\xAC])|\xEA(?:[\xB0-\xBF][\x80-\xBF])|\xEB(?:[\x80-\xBF][\x80-\xBF])|\xEC(?:[\x80-\xBF][\x80-\xBF])|\xED(?:[\x80-\x9D][\x80-\xBF]|\x9E[\x80-\xA3]))'; - -$Ideographic = '(?:\xE3\x80[\x87\xA1-\xA9]|\xE4(?:[\xB8-\xBF][\x80-\xBF])|\xE5(?:[\x80-\xBF][\x80-\xBF])|\xE6(?:[\x80-\xBF][\x80-\xBF])|\xE7(?:[\x80-\xBF][\x80-\xBF])|\xE8(?:[\x80-\xBF][\x80-\xBF])|\xE9(?:[\x80-\xBD][\x80-\xBF]|\xBE[\x80-\xA5]))'; - -$Digit = '(?:[0-9]|\xD9[\xA0-\xA9]|\xDB[\xB0-\xB9]|\xE0(?:\xA5[\xA6-\xAF]|\xA7[\xA6-\xAF]|\xA9[\xA6-\xAF]|\xAB[\xA6-\xAF]|\xAD[\xA6-\xAF]|\xAF[\xA7-\xAF]|\xB1[\xA6-\xAF]|\xB3[\xA6-\xAF]|\xB5[\xA6-\xAF]|\xB9[\x90-\x99]|\xBB[\x90-\x99]|\xBC[\xA0-\xA9]))'; - -$Extender = '(?:\xC2\xB7|\xCB[\x90\x91]|\xCE\x87|\xD9\x80|\xE0(?:\xB9\x86|\xBB\x86)|\xE3(?:\x80[\x85\xB1-\xB5]|\x82[\x9D\x9E]|\x83[\xBC-\xBE]))'; - -$CombiningChar = '(?:\xCC[\x80-\xBF]|\xCD[\x80-\x85\xA0\xA1]|\xD2[\x83-\x86]|\xD6[\x91-\xA1\xA3-\xB9\xBB-\xBD\xBF]|\xD7[\x81\x82\x84]|\xD9[\x8B-\x92\xB0]|\xDB[\x96-\xA4\xA7\xA8\xAA-\xAD]|\xE0(?:\xA4[\x81-\x83\xBC\xBE\xBF]|\xA5[\x80-\x8D\x91-\x94\xA2\xA3]|\xA6[\x81-\x83\xBC\xBE\xBF]|\xA7[\x80-\x84\x87\x88\x8B-\x8D\x97\xA2\xA3]|\xA8[\x82\xBC\xBE\xBF]|\xA9[\x80-\x82\x87\x88\x8B-\x8D\xB0\xB1]|\xAA[\x81-\x83\xBC\xBE\xBF]|\xAB[\x80-\x85\x87-\x89\x8B-\x8D]|\xAC[\x81-\x83\xBC\xBE\xBF]|\xAD[\x80-\x83\x87\x88\x8B-\x8D\x96\x97]|\xAE[\x82\x83\xBE\xBF]|\xAF[\x80-\x82\x86-\x88\x8A-\x8D\x97]|\xB0[\x81-\x83\xBE\xBF]|\xB1[\x80-\x84\x86-\x88\x8A-\x8D\x95\x96]|\xB2[\x82\x83\xBE\xBF]|\xB3[\x80-\x84\x86-\x88\x8A-\x8D\x95\x96]|\xB4[\x82\x83\xBE\xBF]|\xB5[\x80-\x83\x86-\x88\x8A-\x8D\x97]|\xB8[\xB1\xB4-\xBA]|\xB9[\x87-\x8E]|\xBA[\xB1\xB4-\xB9\xBB\xBC]|\xBB[\x88-\x8D]|\xBC[\x98\x99\xB5\xB7\xB9\xBE\xBF]|\xBD[\xB1-\xBF]|\xBE[\x80-\x84\x86-\x8B\x90-\x95\x97\x99-\xAD\xB1-\xB7\xB9])|\xE2\x83[\x90-\x9C\xA1]|\xE3(?:\x80[\xAA-\xAF]|\x82[\x99\x9A]))'; - -$Letter = "(?:$BaseChar|$Ideographic)"; -$NameChar = "(?:[-._:]|$Letter|$Digit|$CombiningChar|$Extender)"; - -$Name = "(?:(?:[:_]|$Letter)$NameChar*)"; -$NmToken = "(?:$NameChar+)"; -$EntityRef = "(?:\&$Name;)"; -$CharRef = "(?:\&#(?:[0-9]+|x[0-9a-fA-F]+);)"; -$Reference = "(?:$EntityRef|$CharRef)"; - -#?? what if it contains entity references? -$AttValue = "(?:\"(?:[^\"&<]*|$Reference)\"|'(?:[^\'&<]|$Reference)*')"; - -######################################################################### -# The following definitions came from the XML Namespaces spec: -######################################################################### - -# Same as $NameChar without the ":" -$NCNameChar = "(?:[-._]|$Letter|$Digit|$CombiningChar|$Extender)"; - -# Same as $Name without the colons -$NCName = "(?:(?:_|$Letter)$NCNameChar*)"; - -$Prefix = $NCName; -$LocalPart = $NCName; -$QName = "(?:(?:$Prefix:)?$LocalPart)"; - -return 1; - -__END__ - -=head1 NAME - -XML::RegExp - Regular expressions for XML tokens - -=head1 SYNOPSIS - - use XML::RegExp; - - if ($my_name =~ /^$XML::RegExp::Name$/) - { - # $my_name is a valid XML 'Name' - } - -=head1 DESCRIPTION - -This package contains regular expressions for the following XML tokens: -BaseChar, Ideographic, Letter, Digit, Extender, CombiningChar, NameChar, -EntityRef, CharRef, Reference, Name, NmToken, and AttValue. - -The definitions of these tokens were taken from the XML spec -(Extensible Markup Language 1.0) at L. - -Also contains the regular expressions for the following tokens from the -XML Namespaces spec at L: -NCNameChar, NCName, QName, Prefix and LocalPart. - -=head1 AUTHOR - -Original Author is Enno Derksen > - -Please send bugs, comments and suggestions to T.J. Mather > - -=head1 COPYRIGHT - -=for COPYRIGHT BEGIN - -Copyright 2022 University of Southampton. -EPrints 3.4 is supplied by EPrints Services. - -http://www.eprints.org/eprints-3.4/ - -=for COPYRIGHT END - -=for LICENSE BEGIN - -This file is part of EPrints 3.4 L. - -EPrints 3.4 and this file are released under the terms of the -GNU Lesser General Public License version 3 as published by -the Free Software Foundation unless otherwise stated. - -EPrints 3.4 is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -See the GNU Lesser General Public License for more details. - -You should have received a copy of the GNU Lesser General Public -License along with EPrints 3.4. -If not, see L. - -=for LICENSE END - diff --git a/perl_lib/XML/SAX/Base.pm b/perl_lib/XML/SAX/Base.pm deleted file mode 100644 index 3fdaaab..0000000 --- a/perl_lib/XML/SAX/Base.pm +++ /dev/null @@ -1,3195 +0,0 @@ -package XML::SAX::Base; - -# version 0.10 - Kip Hampton -# version 0.13 - Robin Berjon -# version 0.15 - Kip Hampton -# version 0.17 - Kip Hampton -# version 0.19 - Kip Hampton -# version 0.21 - Kip Hampton -# version 0.22 - Robin Berjon -# version 0.23 - Matt Sergeant -# version 0.24 - Robin Berjon -# version 0.25 - Kip Hampton -# version 1.00 - Kip Hampton -# version 1.01 - Kip Hampton -# version 1.02 - Robin Berjon -# version 1.03 - Matt Sergeant -# version 1.04 - Kip Hampton - -#-----------------------------------------------------# -# STOP!!!!! -# -# This file is generated by the 'Makefile.PL' file -# that ships with the XML::SAX distribution. -# If you need to make changes, patch that file NOT -# this one. -#-----------------------------------------------------# - -use strict; -use vars qw($VERSION); -use XML::SAX::Exception qw(); - -$VERSION = '1.04'; - -sub end_prefix_mapping { - my $self = shift; - if (defined $self->{Methods}->{'end_prefix_mapping'}) { - $self->{Methods}->{'end_prefix_mapping'}->(@_); - } - else { - my $method; - my $callbacks; - if (exists $self->{ParseOptions}) { - $callbacks = $self->{ParseOptions}; - } - else { - $callbacks = $self; - } - if (0) { # dummy to make elsif's below compile - } - elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('end_prefix_mapping') ) { - my $handler = $callbacks->{'ContentHandler'}; - $self->{Methods}->{'end_prefix_mapping'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('end_prefix_mapping') ) { - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'end_prefix_mapping'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'ContentHandler'} - and $callbacks->{'ContentHandler'}->can('AUTOLOAD') - and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'ContentHandler'}->end_prefix_mapping(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'ContentHandler'}; - $self->{Methods}->{'end_prefix_mapping'} = sub { $handler->end_prefix_mapping(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'Handler'} - and $callbacks->{'Handler'}->can('AUTOLOAD') - and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'Handler'}->end_prefix_mapping(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'end_prefix_mapping'} = sub { $handler->end_prefix_mapping(@_) }; - } - return $res; - } - else { - $self->{Methods}->{'end_prefix_mapping'} = sub { }; - } - } - -} - -sub internal_entity_decl { - my $self = shift; - if (defined $self->{Methods}->{'internal_entity_decl'}) { - $self->{Methods}->{'internal_entity_decl'}->(@_); - } - else { - my $method; - my $callbacks; - if (exists $self->{ParseOptions}) { - $callbacks = $self->{ParseOptions}; - } - else { - $callbacks = $self; - } - if (0) { # dummy to make elsif's below compile - } - elsif (defined $callbacks->{'DeclHandler'} and $method = $callbacks->{'DeclHandler'}->can('internal_entity_decl') ) { - my $handler = $callbacks->{'DeclHandler'}; - $self->{Methods}->{'internal_entity_decl'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('internal_entity_decl') ) { - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'internal_entity_decl'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'DeclHandler'} - and $callbacks->{'DeclHandler'}->can('AUTOLOAD') - and $callbacks->{'DeclHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'DeclHandler'}->internal_entity_decl(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'DeclHandler'}; - $self->{Methods}->{'internal_entity_decl'} = sub { $handler->internal_entity_decl(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'Handler'} - and $callbacks->{'Handler'}->can('AUTOLOAD') - and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'Handler'}->internal_entity_decl(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'internal_entity_decl'} = sub { $handler->internal_entity_decl(@_) }; - } - return $res; - } - else { - $self->{Methods}->{'internal_entity_decl'} = sub { }; - } - } - -} - -sub characters { - my $self = shift; - if (defined $self->{Methods}->{'characters'}) { - $self->{Methods}->{'characters'}->(@_); - } - else { - my $method; - my $callbacks; - if (exists $self->{ParseOptions}) { - $callbacks = $self->{ParseOptions}; - } - else { - $callbacks = $self; - } - if (0) { # dummy to make elsif's below compile - } - elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('characters') ) { - my $handler = $callbacks->{'ContentHandler'}; - $self->{Methods}->{'characters'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('characters') ) { - my $handler = $callbacks->{'DocumentHandler'}; - $self->{Methods}->{'characters'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('characters') ) { - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'characters'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'ContentHandler'} - and $callbacks->{'ContentHandler'}->can('AUTOLOAD') - and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'ContentHandler'}->characters(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'ContentHandler'}; - $self->{Methods}->{'characters'} = sub { $handler->characters(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'DocumentHandler'} - and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') - and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'DocumentHandler'}->characters(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'DocumentHandler'}; - $self->{Methods}->{'characters'} = sub { $handler->characters(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'Handler'} - and $callbacks->{'Handler'}->can('AUTOLOAD') - and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'Handler'}->characters(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'characters'} = sub { $handler->characters(@_) }; - } - return $res; - } - else { - $self->{Methods}->{'characters'} = sub { }; - } - } - -} - -sub start_element { - my $self = shift; - if (defined $self->{Methods}->{'start_element'}) { - $self->{Methods}->{'start_element'}->(@_); - } - else { - my $method; - my $callbacks; - if (exists $self->{ParseOptions}) { - $callbacks = $self->{ParseOptions}; - } - else { - $callbacks = $self; - } - if (0) { # dummy to make elsif's below compile - } - elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('start_element') ) { - my $handler = $callbacks->{'ContentHandler'}; - $self->{Methods}->{'start_element'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('start_element') ) { - my $handler = $callbacks->{'DocumentHandler'}; - $self->{Methods}->{'start_element'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('start_element') ) { - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'start_element'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'ContentHandler'} - and $callbacks->{'ContentHandler'}->can('AUTOLOAD') - and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'ContentHandler'}->start_element(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'ContentHandler'}; - $self->{Methods}->{'start_element'} = sub { $handler->start_element(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'DocumentHandler'} - and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') - and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'DocumentHandler'}->start_element(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'DocumentHandler'}; - $self->{Methods}->{'start_element'} = sub { $handler->start_element(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'Handler'} - and $callbacks->{'Handler'}->can('AUTOLOAD') - and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'Handler'}->start_element(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'start_element'} = sub { $handler->start_element(@_) }; - } - return $res; - } - else { - $self->{Methods}->{'start_element'} = sub { }; - } - } - -} - -sub external_entity_decl { - my $self = shift; - if (defined $self->{Methods}->{'external_entity_decl'}) { - $self->{Methods}->{'external_entity_decl'}->(@_); - } - else { - my $method; - my $callbacks; - if (exists $self->{ParseOptions}) { - $callbacks = $self->{ParseOptions}; - } - else { - $callbacks = $self; - } - if (0) { # dummy to make elsif's below compile - } - elsif (defined $callbacks->{'DeclHandler'} and $method = $callbacks->{'DeclHandler'}->can('external_entity_decl') ) { - my $handler = $callbacks->{'DeclHandler'}; - $self->{Methods}->{'external_entity_decl'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('external_entity_decl') ) { - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'external_entity_decl'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'DeclHandler'} - and $callbacks->{'DeclHandler'}->can('AUTOLOAD') - and $callbacks->{'DeclHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'DeclHandler'}->external_entity_decl(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'DeclHandler'}; - $self->{Methods}->{'external_entity_decl'} = sub { $handler->external_entity_decl(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'Handler'} - and $callbacks->{'Handler'}->can('AUTOLOAD') - and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'Handler'}->external_entity_decl(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'external_entity_decl'} = sub { $handler->external_entity_decl(@_) }; - } - return $res; - } - else { - $self->{Methods}->{'external_entity_decl'} = sub { }; - } - } - -} - -sub xml_decl { - my $self = shift; - if (defined $self->{Methods}->{'xml_decl'}) { - $self->{Methods}->{'xml_decl'}->(@_); - } - else { - my $method; - my $callbacks; - if (exists $self->{ParseOptions}) { - $callbacks = $self->{ParseOptions}; - } - else { - $callbacks = $self; - } - if (0) { # dummy to make elsif's below compile - } - elsif (defined $callbacks->{'DTDHandler'} and $method = $callbacks->{'DTDHandler'}->can('xml_decl') ) { - my $handler = $callbacks->{'DTDHandler'}; - $self->{Methods}->{'xml_decl'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('xml_decl') ) { - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'xml_decl'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'DTDHandler'} - and $callbacks->{'DTDHandler'}->can('AUTOLOAD') - and $callbacks->{'DTDHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'DTDHandler'}->xml_decl(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'DTDHandler'}; - $self->{Methods}->{'xml_decl'} = sub { $handler->xml_decl(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'Handler'} - and $callbacks->{'Handler'}->can('AUTOLOAD') - and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'Handler'}->xml_decl(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'xml_decl'} = sub { $handler->xml_decl(@_) }; - } - return $res; - } - else { - $self->{Methods}->{'xml_decl'} = sub { }; - } - } - -} - -sub entity_decl { - my $self = shift; - if (defined $self->{Methods}->{'entity_decl'}) { - $self->{Methods}->{'entity_decl'}->(@_); - } - else { - my $method; - my $callbacks; - if (exists $self->{ParseOptions}) { - $callbacks = $self->{ParseOptions}; - } - else { - $callbacks = $self; - } - if (0) { # dummy to make elsif's below compile - } - elsif (defined $callbacks->{'DTDHandler'} and $method = $callbacks->{'DTDHandler'}->can('entity_decl') ) { - my $handler = $callbacks->{'DTDHandler'}; - $self->{Methods}->{'entity_decl'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('entity_decl') ) { - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'entity_decl'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'DTDHandler'} - and $callbacks->{'DTDHandler'}->can('AUTOLOAD') - and $callbacks->{'DTDHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'DTDHandler'}->entity_decl(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'DTDHandler'}; - $self->{Methods}->{'entity_decl'} = sub { $handler->entity_decl(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'Handler'} - and $callbacks->{'Handler'}->can('AUTOLOAD') - and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'Handler'}->entity_decl(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'entity_decl'} = sub { $handler->entity_decl(@_) }; - } - return $res; - } - else { - $self->{Methods}->{'entity_decl'} = sub { }; - } - } - -} - -sub end_dtd { - my $self = shift; - if (defined $self->{Methods}->{'end_dtd'}) { - $self->{Methods}->{'end_dtd'}->(@_); - } - else { - my $method; - my $callbacks; - if (exists $self->{ParseOptions}) { - $callbacks = $self->{ParseOptions}; - } - else { - $callbacks = $self; - } - if (0) { # dummy to make elsif's below compile - } - elsif (defined $callbacks->{'LexicalHandler'} and $method = $callbacks->{'LexicalHandler'}->can('end_dtd') ) { - my $handler = $callbacks->{'LexicalHandler'}; - $self->{Methods}->{'end_dtd'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('end_dtd') ) { - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'end_dtd'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'LexicalHandler'} - and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') - and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'LexicalHandler'}->end_dtd(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'LexicalHandler'}; - $self->{Methods}->{'end_dtd'} = sub { $handler->end_dtd(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'Handler'} - and $callbacks->{'Handler'}->can('AUTOLOAD') - and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'Handler'}->end_dtd(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'end_dtd'} = sub { $handler->end_dtd(@_) }; - } - return $res; - } - else { - $self->{Methods}->{'end_dtd'} = sub { }; - } - } - -} - -sub unparsed_entity_decl { - my $self = shift; - if (defined $self->{Methods}->{'unparsed_entity_decl'}) { - $self->{Methods}->{'unparsed_entity_decl'}->(@_); - } - else { - my $method; - my $callbacks; - if (exists $self->{ParseOptions}) { - $callbacks = $self->{ParseOptions}; - } - else { - $callbacks = $self; - } - if (0) { # dummy to make elsif's below compile - } - elsif (defined $callbacks->{'DTDHandler'} and $method = $callbacks->{'DTDHandler'}->can('unparsed_entity_decl') ) { - my $handler = $callbacks->{'DTDHandler'}; - $self->{Methods}->{'unparsed_entity_decl'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('unparsed_entity_decl') ) { - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'unparsed_entity_decl'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'DTDHandler'} - and $callbacks->{'DTDHandler'}->can('AUTOLOAD') - and $callbacks->{'DTDHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'DTDHandler'}->unparsed_entity_decl(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'DTDHandler'}; - $self->{Methods}->{'unparsed_entity_decl'} = sub { $handler->unparsed_entity_decl(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'Handler'} - and $callbacks->{'Handler'}->can('AUTOLOAD') - and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'Handler'}->unparsed_entity_decl(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'unparsed_entity_decl'} = sub { $handler->unparsed_entity_decl(@_) }; - } - return $res; - } - else { - $self->{Methods}->{'unparsed_entity_decl'} = sub { }; - } - } - -} - -sub processing_instruction { - my $self = shift; - if (defined $self->{Methods}->{'processing_instruction'}) { - $self->{Methods}->{'processing_instruction'}->(@_); - } - else { - my $method; - my $callbacks; - if (exists $self->{ParseOptions}) { - $callbacks = $self->{ParseOptions}; - } - else { - $callbacks = $self; - } - if (0) { # dummy to make elsif's below compile - } - elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('processing_instruction') ) { - my $handler = $callbacks->{'ContentHandler'}; - $self->{Methods}->{'processing_instruction'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('processing_instruction') ) { - my $handler = $callbacks->{'DocumentHandler'}; - $self->{Methods}->{'processing_instruction'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('processing_instruction') ) { - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'processing_instruction'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'ContentHandler'} - and $callbacks->{'ContentHandler'}->can('AUTOLOAD') - and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'ContentHandler'}->processing_instruction(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'ContentHandler'}; - $self->{Methods}->{'processing_instruction'} = sub { $handler->processing_instruction(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'DocumentHandler'} - and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') - and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'DocumentHandler'}->processing_instruction(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'DocumentHandler'}; - $self->{Methods}->{'processing_instruction'} = sub { $handler->processing_instruction(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'Handler'} - and $callbacks->{'Handler'}->can('AUTOLOAD') - and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'Handler'}->processing_instruction(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'processing_instruction'} = sub { $handler->processing_instruction(@_) }; - } - return $res; - } - else { - $self->{Methods}->{'processing_instruction'} = sub { }; - } - } - -} - -sub attribute_decl { - my $self = shift; - if (defined $self->{Methods}->{'attribute_decl'}) { - $self->{Methods}->{'attribute_decl'}->(@_); - } - else { - my $method; - my $callbacks; - if (exists $self->{ParseOptions}) { - $callbacks = $self->{ParseOptions}; - } - else { - $callbacks = $self; - } - if (0) { # dummy to make elsif's below compile - } - elsif (defined $callbacks->{'DeclHandler'} and $method = $callbacks->{'DeclHandler'}->can('attribute_decl') ) { - my $handler = $callbacks->{'DeclHandler'}; - $self->{Methods}->{'attribute_decl'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('attribute_decl') ) { - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'attribute_decl'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'DeclHandler'} - and $callbacks->{'DeclHandler'}->can('AUTOLOAD') - and $callbacks->{'DeclHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'DeclHandler'}->attribute_decl(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'DeclHandler'}; - $self->{Methods}->{'attribute_decl'} = sub { $handler->attribute_decl(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'Handler'} - and $callbacks->{'Handler'}->can('AUTOLOAD') - and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'Handler'}->attribute_decl(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'attribute_decl'} = sub { $handler->attribute_decl(@_) }; - } - return $res; - } - else { - $self->{Methods}->{'attribute_decl'} = sub { }; - } - } - -} - -sub fatal_error { - my $self = shift; - if (defined $self->{Methods}->{'fatal_error'}) { - $self->{Methods}->{'fatal_error'}->(@_); - } - else { - my $method; - my $callbacks; - if (exists $self->{ParseOptions}) { - $callbacks = $self->{ParseOptions}; - } - else { - $callbacks = $self; - } - if (0) { # dummy to make elsif's below compile - } - elsif (defined $callbacks->{'ErrorHandler'} and $method = $callbacks->{'ErrorHandler'}->can('fatal_error') ) { - my $handler = $callbacks->{'ErrorHandler'}; - $self->{Methods}->{'fatal_error'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('fatal_error') ) { - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'fatal_error'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'ErrorHandler'} - and $callbacks->{'ErrorHandler'}->can('AUTOLOAD') - and $callbacks->{'ErrorHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'ErrorHandler'}->fatal_error(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'ErrorHandler'}; - $self->{Methods}->{'fatal_error'} = sub { $handler->fatal_error(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'Handler'} - and $callbacks->{'Handler'}->can('AUTOLOAD') - and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'Handler'}->fatal_error(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'fatal_error'} = sub { $handler->fatal_error(@_) }; - } - return $res; - } - else { - $self->{Methods}->{'fatal_error'} = sub { }; - } - } - -} - -sub end_cdata { - my $self = shift; - if (defined $self->{Methods}->{'end_cdata'}) { - $self->{Methods}->{'end_cdata'}->(@_); - } - else { - my $method; - my $callbacks; - if (exists $self->{ParseOptions}) { - $callbacks = $self->{ParseOptions}; - } - else { - $callbacks = $self; - } - if (0) { # dummy to make elsif's below compile - } - elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('end_cdata') ) { - my $handler = $callbacks->{'DocumentHandler'}; - $self->{Methods}->{'end_cdata'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'LexicalHandler'} and $method = $callbacks->{'LexicalHandler'}->can('end_cdata') ) { - my $handler = $callbacks->{'LexicalHandler'}; - $self->{Methods}->{'end_cdata'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('end_cdata') ) { - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'end_cdata'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'DocumentHandler'} - and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') - and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'DocumentHandler'}->end_cdata(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'DocumentHandler'}; - $self->{Methods}->{'end_cdata'} = sub { $handler->end_cdata(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'LexicalHandler'} - and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') - and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'LexicalHandler'}->end_cdata(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'LexicalHandler'}; - $self->{Methods}->{'end_cdata'} = sub { $handler->end_cdata(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'Handler'} - and $callbacks->{'Handler'}->can('AUTOLOAD') - and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'Handler'}->end_cdata(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'end_cdata'} = sub { $handler->end_cdata(@_) }; - } - return $res; - } - else { - $self->{Methods}->{'end_cdata'} = sub { }; - } - } - -} - -sub start_entity { - my $self = shift; - if (defined $self->{Methods}->{'start_entity'}) { - $self->{Methods}->{'start_entity'}->(@_); - } - else { - my $method; - my $callbacks; - if (exists $self->{ParseOptions}) { - $callbacks = $self->{ParseOptions}; - } - else { - $callbacks = $self; - } - if (0) { # dummy to make elsif's below compile - } - elsif (defined $callbacks->{'LexicalHandler'} and $method = $callbacks->{'LexicalHandler'}->can('start_entity') ) { - my $handler = $callbacks->{'LexicalHandler'}; - $self->{Methods}->{'start_entity'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('start_entity') ) { - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'start_entity'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'LexicalHandler'} - and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') - and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'LexicalHandler'}->start_entity(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'LexicalHandler'}; - $self->{Methods}->{'start_entity'} = sub { $handler->start_entity(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'Handler'} - and $callbacks->{'Handler'}->can('AUTOLOAD') - and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'Handler'}->start_entity(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'start_entity'} = sub { $handler->start_entity(@_) }; - } - return $res; - } - else { - $self->{Methods}->{'start_entity'} = sub { }; - } - } - -} - -sub start_prefix_mapping { - my $self = shift; - if (defined $self->{Methods}->{'start_prefix_mapping'}) { - $self->{Methods}->{'start_prefix_mapping'}->(@_); - } - else { - my $method; - my $callbacks; - if (exists $self->{ParseOptions}) { - $callbacks = $self->{ParseOptions}; - } - else { - $callbacks = $self; - } - if (0) { # dummy to make elsif's below compile - } - elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('start_prefix_mapping') ) { - my $handler = $callbacks->{'ContentHandler'}; - $self->{Methods}->{'start_prefix_mapping'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('start_prefix_mapping') ) { - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'start_prefix_mapping'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'ContentHandler'} - and $callbacks->{'ContentHandler'}->can('AUTOLOAD') - and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'ContentHandler'}->start_prefix_mapping(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'ContentHandler'}; - $self->{Methods}->{'start_prefix_mapping'} = sub { $handler->start_prefix_mapping(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'Handler'} - and $callbacks->{'Handler'}->can('AUTOLOAD') - and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'Handler'}->start_prefix_mapping(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'start_prefix_mapping'} = sub { $handler->start_prefix_mapping(@_) }; - } - return $res; - } - else { - $self->{Methods}->{'start_prefix_mapping'} = sub { }; - } - } - -} - -sub error { - my $self = shift; - if (defined $self->{Methods}->{'error'}) { - $self->{Methods}->{'error'}->(@_); - } - else { - my $method; - my $callbacks; - if (exists $self->{ParseOptions}) { - $callbacks = $self->{ParseOptions}; - } - else { - $callbacks = $self; - } - if (0) { # dummy to make elsif's below compile - } - elsif (defined $callbacks->{'ErrorHandler'} and $method = $callbacks->{'ErrorHandler'}->can('error') ) { - my $handler = $callbacks->{'ErrorHandler'}; - $self->{Methods}->{'error'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('error') ) { - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'error'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'ErrorHandler'} - and $callbacks->{'ErrorHandler'}->can('AUTOLOAD') - and $callbacks->{'ErrorHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'ErrorHandler'}->error(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'ErrorHandler'}; - $self->{Methods}->{'error'} = sub { $handler->error(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'Handler'} - and $callbacks->{'Handler'}->can('AUTOLOAD') - and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'Handler'}->error(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'error'} = sub { $handler->error(@_) }; - } - return $res; - } - else { - $self->{Methods}->{'error'} = sub { }; - } - } - -} - -sub start_document { - my $self = shift; - if (defined $self->{Methods}->{'start_document'}) { - $self->{Methods}->{'start_document'}->(@_); - } - else { - my $method; - my $callbacks; - if (exists $self->{ParseOptions}) { - $callbacks = $self->{ParseOptions}; - } - else { - $callbacks = $self; - } - if (0) { # dummy to make elsif's below compile - } - elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('start_document') ) { - my $handler = $callbacks->{'ContentHandler'}; - $self->{Methods}->{'start_document'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('start_document') ) { - my $handler = $callbacks->{'DocumentHandler'}; - $self->{Methods}->{'start_document'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('start_document') ) { - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'start_document'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'ContentHandler'} - and $callbacks->{'ContentHandler'}->can('AUTOLOAD') - and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'ContentHandler'}->start_document(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'ContentHandler'}; - $self->{Methods}->{'start_document'} = sub { $handler->start_document(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'DocumentHandler'} - and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') - and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'DocumentHandler'}->start_document(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'DocumentHandler'}; - $self->{Methods}->{'start_document'} = sub { $handler->start_document(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'Handler'} - and $callbacks->{'Handler'}->can('AUTOLOAD') - and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'Handler'}->start_document(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'start_document'} = sub { $handler->start_document(@_) }; - } - return $res; - } - else { - $self->{Methods}->{'start_document'} = sub { }; - } - } - -} - -sub ignorable_whitespace { - my $self = shift; - if (defined $self->{Methods}->{'ignorable_whitespace'}) { - $self->{Methods}->{'ignorable_whitespace'}->(@_); - } - else { - my $method; - my $callbacks; - if (exists $self->{ParseOptions}) { - $callbacks = $self->{ParseOptions}; - } - else { - $callbacks = $self; - } - if (0) { # dummy to make elsif's below compile - } - elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('ignorable_whitespace') ) { - my $handler = $callbacks->{'ContentHandler'}; - $self->{Methods}->{'ignorable_whitespace'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('ignorable_whitespace') ) { - my $handler = $callbacks->{'DocumentHandler'}; - $self->{Methods}->{'ignorable_whitespace'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('ignorable_whitespace') ) { - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'ignorable_whitespace'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'ContentHandler'} - and $callbacks->{'ContentHandler'}->can('AUTOLOAD') - and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'ContentHandler'}->ignorable_whitespace(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'ContentHandler'}; - $self->{Methods}->{'ignorable_whitespace'} = sub { $handler->ignorable_whitespace(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'DocumentHandler'} - and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') - and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'DocumentHandler'}->ignorable_whitespace(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'DocumentHandler'}; - $self->{Methods}->{'ignorable_whitespace'} = sub { $handler->ignorable_whitespace(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'Handler'} - and $callbacks->{'Handler'}->can('AUTOLOAD') - and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'Handler'}->ignorable_whitespace(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'ignorable_whitespace'} = sub { $handler->ignorable_whitespace(@_) }; - } - return $res; - } - else { - $self->{Methods}->{'ignorable_whitespace'} = sub { }; - } - } - -} - -sub end_document { - my $self = shift; - if (defined $self->{Methods}->{'end_document'}) { - $self->{Methods}->{'end_document'}->(@_); - } - else { - my $method; - my $callbacks; - if (exists $self->{ParseOptions}) { - $callbacks = $self->{ParseOptions}; - } - else { - $callbacks = $self; - } - if (0) { # dummy to make elsif's below compile - } - elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('end_document') ) { - my $handler = $callbacks->{'ContentHandler'}; - $self->{Methods}->{'end_document'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('end_document') ) { - my $handler = $callbacks->{'DocumentHandler'}; - $self->{Methods}->{'end_document'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('end_document') ) { - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'end_document'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'ContentHandler'} - and $callbacks->{'ContentHandler'}->can('AUTOLOAD') - and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'ContentHandler'}->end_document(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'ContentHandler'}; - $self->{Methods}->{'end_document'} = sub { $handler->end_document(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'DocumentHandler'} - and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') - and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'DocumentHandler'}->end_document(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'DocumentHandler'}; - $self->{Methods}->{'end_document'} = sub { $handler->end_document(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'Handler'} - and $callbacks->{'Handler'}->can('AUTOLOAD') - and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'Handler'}->end_document(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'end_document'} = sub { $handler->end_document(@_) }; - } - return $res; - } - else { - $self->{Methods}->{'end_document'} = sub { }; - } - } - -} - -sub start_cdata { - my $self = shift; - if (defined $self->{Methods}->{'start_cdata'}) { - $self->{Methods}->{'start_cdata'}->(@_); - } - else { - my $method; - my $callbacks; - if (exists $self->{ParseOptions}) { - $callbacks = $self->{ParseOptions}; - } - else { - $callbacks = $self; - } - if (0) { # dummy to make elsif's below compile - } - elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('start_cdata') ) { - my $handler = $callbacks->{'DocumentHandler'}; - $self->{Methods}->{'start_cdata'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'LexicalHandler'} and $method = $callbacks->{'LexicalHandler'}->can('start_cdata') ) { - my $handler = $callbacks->{'LexicalHandler'}; - $self->{Methods}->{'start_cdata'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('start_cdata') ) { - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'start_cdata'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'DocumentHandler'} - and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') - and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'DocumentHandler'}->start_cdata(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'DocumentHandler'}; - $self->{Methods}->{'start_cdata'} = sub { $handler->start_cdata(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'LexicalHandler'} - and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') - and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'LexicalHandler'}->start_cdata(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'LexicalHandler'}; - $self->{Methods}->{'start_cdata'} = sub { $handler->start_cdata(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'Handler'} - and $callbacks->{'Handler'}->can('AUTOLOAD') - and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'Handler'}->start_cdata(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'start_cdata'} = sub { $handler->start_cdata(@_) }; - } - return $res; - } - else { - $self->{Methods}->{'start_cdata'} = sub { }; - } - } - -} - -sub set_document_locator { - my $self = shift; - if (defined $self->{Methods}->{'set_document_locator'}) { - $self->{Methods}->{'set_document_locator'}->(@_); - } - else { - my $method; - my $callbacks; - if (exists $self->{ParseOptions}) { - $callbacks = $self->{ParseOptions}; - } - else { - $callbacks = $self; - } - if (0) { # dummy to make elsif's below compile - } - elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('set_document_locator') ) { - my $handler = $callbacks->{'ContentHandler'}; - $self->{Methods}->{'set_document_locator'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('set_document_locator') ) { - my $handler = $callbacks->{'DocumentHandler'}; - $self->{Methods}->{'set_document_locator'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('set_document_locator') ) { - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'set_document_locator'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'ContentHandler'} - and $callbacks->{'ContentHandler'}->can('AUTOLOAD') - and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'ContentHandler'}->set_document_locator(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'ContentHandler'}; - $self->{Methods}->{'set_document_locator'} = sub { $handler->set_document_locator(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'DocumentHandler'} - and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') - and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'DocumentHandler'}->set_document_locator(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'DocumentHandler'}; - $self->{Methods}->{'set_document_locator'} = sub { $handler->set_document_locator(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'Handler'} - and $callbacks->{'Handler'}->can('AUTOLOAD') - and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'Handler'}->set_document_locator(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'set_document_locator'} = sub { $handler->set_document_locator(@_) }; - } - return $res; - } - else { - $self->{Methods}->{'set_document_locator'} = sub { }; - } - } - -} - -sub attlist_decl { - my $self = shift; - if (defined $self->{Methods}->{'attlist_decl'}) { - $self->{Methods}->{'attlist_decl'}->(@_); - } - else { - my $method; - my $callbacks; - if (exists $self->{ParseOptions}) { - $callbacks = $self->{ParseOptions}; - } - else { - $callbacks = $self; - } - if (0) { # dummy to make elsif's below compile - } - elsif (defined $callbacks->{'DTDHandler'} and $method = $callbacks->{'DTDHandler'}->can('attlist_decl') ) { - my $handler = $callbacks->{'DTDHandler'}; - $self->{Methods}->{'attlist_decl'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('attlist_decl') ) { - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'attlist_decl'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'DTDHandler'} - and $callbacks->{'DTDHandler'}->can('AUTOLOAD') - and $callbacks->{'DTDHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'DTDHandler'}->attlist_decl(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'DTDHandler'}; - $self->{Methods}->{'attlist_decl'} = sub { $handler->attlist_decl(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'Handler'} - and $callbacks->{'Handler'}->can('AUTOLOAD') - and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'Handler'}->attlist_decl(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'attlist_decl'} = sub { $handler->attlist_decl(@_) }; - } - return $res; - } - else { - $self->{Methods}->{'attlist_decl'} = sub { }; - } - } - -} - -sub start_dtd { - my $self = shift; - if (defined $self->{Methods}->{'start_dtd'}) { - $self->{Methods}->{'start_dtd'}->(@_); - } - else { - my $method; - my $callbacks; - if (exists $self->{ParseOptions}) { - $callbacks = $self->{ParseOptions}; - } - else { - $callbacks = $self; - } - if (0) { # dummy to make elsif's below compile - } - elsif (defined $callbacks->{'LexicalHandler'} and $method = $callbacks->{'LexicalHandler'}->can('start_dtd') ) { - my $handler = $callbacks->{'LexicalHandler'}; - $self->{Methods}->{'start_dtd'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('start_dtd') ) { - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'start_dtd'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'LexicalHandler'} - and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') - and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'LexicalHandler'}->start_dtd(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'LexicalHandler'}; - $self->{Methods}->{'start_dtd'} = sub { $handler->start_dtd(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'Handler'} - and $callbacks->{'Handler'}->can('AUTOLOAD') - and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'Handler'}->start_dtd(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'start_dtd'} = sub { $handler->start_dtd(@_) }; - } - return $res; - } - else { - $self->{Methods}->{'start_dtd'} = sub { }; - } - } - -} - -sub resolve_entity { - my $self = shift; - if (defined $self->{Methods}->{'resolve_entity'}) { - $self->{Methods}->{'resolve_entity'}->(@_); - } - else { - my $method; - my $callbacks; - if (exists $self->{ParseOptions}) { - $callbacks = $self->{ParseOptions}; - } - else { - $callbacks = $self; - } - if (0) { # dummy to make elsif's below compile - } - elsif (defined $callbacks->{'EntityResolver'} and $method = $callbacks->{'EntityResolver'}->can('resolve_entity') ) { - my $handler = $callbacks->{'EntityResolver'}; - $self->{Methods}->{'resolve_entity'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('resolve_entity') ) { - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'resolve_entity'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'EntityResolver'} - and $callbacks->{'EntityResolver'}->can('AUTOLOAD') - and $callbacks->{'EntityResolver'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'EntityResolver'}->resolve_entity(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'EntityResolver'}; - $self->{Methods}->{'resolve_entity'} = sub { $handler->resolve_entity(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'Handler'} - and $callbacks->{'Handler'}->can('AUTOLOAD') - and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'Handler'}->resolve_entity(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'resolve_entity'} = sub { $handler->resolve_entity(@_) }; - } - return $res; - } - else { - $self->{Methods}->{'resolve_entity'} = sub { }; - } - } - -} - -sub entity_reference { - my $self = shift; - if (defined $self->{Methods}->{'entity_reference'}) { - $self->{Methods}->{'entity_reference'}->(@_); - } - else { - my $method; - my $callbacks; - if (exists $self->{ParseOptions}) { - $callbacks = $self->{ParseOptions}; - } - else { - $callbacks = $self; - } - if (0) { # dummy to make elsif's below compile - } - elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('entity_reference') ) { - my $handler = $callbacks->{'DocumentHandler'}; - $self->{Methods}->{'entity_reference'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('entity_reference') ) { - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'entity_reference'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'DocumentHandler'} - and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') - and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'DocumentHandler'}->entity_reference(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'DocumentHandler'}; - $self->{Methods}->{'entity_reference'} = sub { $handler->entity_reference(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'Handler'} - and $callbacks->{'Handler'}->can('AUTOLOAD') - and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'Handler'}->entity_reference(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'entity_reference'} = sub { $handler->entity_reference(@_) }; - } - return $res; - } - else { - $self->{Methods}->{'entity_reference'} = sub { }; - } - } - -} - -sub element_decl { - my $self = shift; - if (defined $self->{Methods}->{'element_decl'}) { - $self->{Methods}->{'element_decl'}->(@_); - } - else { - my $method; - my $callbacks; - if (exists $self->{ParseOptions}) { - $callbacks = $self->{ParseOptions}; - } - else { - $callbacks = $self; - } - if (0) { # dummy to make elsif's below compile - } - elsif (defined $callbacks->{'DeclHandler'} and $method = $callbacks->{'DeclHandler'}->can('element_decl') ) { - my $handler = $callbacks->{'DeclHandler'}; - $self->{Methods}->{'element_decl'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('element_decl') ) { - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'element_decl'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'DeclHandler'} - and $callbacks->{'DeclHandler'}->can('AUTOLOAD') - and $callbacks->{'DeclHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'DeclHandler'}->element_decl(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'DeclHandler'}; - $self->{Methods}->{'element_decl'} = sub { $handler->element_decl(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'Handler'} - and $callbacks->{'Handler'}->can('AUTOLOAD') - and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'Handler'}->element_decl(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'element_decl'} = sub { $handler->element_decl(@_) }; - } - return $res; - } - else { - $self->{Methods}->{'element_decl'} = sub { }; - } - } - -} - -sub notation_decl { - my $self = shift; - if (defined $self->{Methods}->{'notation_decl'}) { - $self->{Methods}->{'notation_decl'}->(@_); - } - else { - my $method; - my $callbacks; - if (exists $self->{ParseOptions}) { - $callbacks = $self->{ParseOptions}; - } - else { - $callbacks = $self; - } - if (0) { # dummy to make elsif's below compile - } - elsif (defined $callbacks->{'DTDHandler'} and $method = $callbacks->{'DTDHandler'}->can('notation_decl') ) { - my $handler = $callbacks->{'DTDHandler'}; - $self->{Methods}->{'notation_decl'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('notation_decl') ) { - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'notation_decl'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'DTDHandler'} - and $callbacks->{'DTDHandler'}->can('AUTOLOAD') - and $callbacks->{'DTDHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'DTDHandler'}->notation_decl(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'DTDHandler'}; - $self->{Methods}->{'notation_decl'} = sub { $handler->notation_decl(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'Handler'} - and $callbacks->{'Handler'}->can('AUTOLOAD') - and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'Handler'}->notation_decl(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'notation_decl'} = sub { $handler->notation_decl(@_) }; - } - return $res; - } - else { - $self->{Methods}->{'notation_decl'} = sub { }; - } - } - -} - -sub skipped_entity { - my $self = shift; - if (defined $self->{Methods}->{'skipped_entity'}) { - $self->{Methods}->{'skipped_entity'}->(@_); - } - else { - my $method; - my $callbacks; - if (exists $self->{ParseOptions}) { - $callbacks = $self->{ParseOptions}; - } - else { - $callbacks = $self; - } - if (0) { # dummy to make elsif's below compile - } - elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('skipped_entity') ) { - my $handler = $callbacks->{'ContentHandler'}; - $self->{Methods}->{'skipped_entity'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('skipped_entity') ) { - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'skipped_entity'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'ContentHandler'} - and $callbacks->{'ContentHandler'}->can('AUTOLOAD') - and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'ContentHandler'}->skipped_entity(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'ContentHandler'}; - $self->{Methods}->{'skipped_entity'} = sub { $handler->skipped_entity(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'Handler'} - and $callbacks->{'Handler'}->can('AUTOLOAD') - and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'Handler'}->skipped_entity(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'skipped_entity'} = sub { $handler->skipped_entity(@_) }; - } - return $res; - } - else { - $self->{Methods}->{'skipped_entity'} = sub { }; - } - } - -} - -sub end_element { - my $self = shift; - if (defined $self->{Methods}->{'end_element'}) { - $self->{Methods}->{'end_element'}->(@_); - } - else { - my $method; - my $callbacks; - if (exists $self->{ParseOptions}) { - $callbacks = $self->{ParseOptions}; - } - else { - $callbacks = $self; - } - if (0) { # dummy to make elsif's below compile - } - elsif (defined $callbacks->{'ContentHandler'} and $method = $callbacks->{'ContentHandler'}->can('end_element') ) { - my $handler = $callbacks->{'ContentHandler'}; - $self->{Methods}->{'end_element'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('end_element') ) { - my $handler = $callbacks->{'DocumentHandler'}; - $self->{Methods}->{'end_element'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('end_element') ) { - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'end_element'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'ContentHandler'} - and $callbacks->{'ContentHandler'}->can('AUTOLOAD') - and $callbacks->{'ContentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'ContentHandler'}->end_element(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'ContentHandler'}; - $self->{Methods}->{'end_element'} = sub { $handler->end_element(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'DocumentHandler'} - and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') - and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'DocumentHandler'}->end_element(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'DocumentHandler'}; - $self->{Methods}->{'end_element'} = sub { $handler->end_element(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'Handler'} - and $callbacks->{'Handler'}->can('AUTOLOAD') - and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'Handler'}->end_element(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'end_element'} = sub { $handler->end_element(@_) }; - } - return $res; - } - else { - $self->{Methods}->{'end_element'} = sub { }; - } - } - -} - -sub doctype_decl { - my $self = shift; - if (defined $self->{Methods}->{'doctype_decl'}) { - $self->{Methods}->{'doctype_decl'}->(@_); - } - else { - my $method; - my $callbacks; - if (exists $self->{ParseOptions}) { - $callbacks = $self->{ParseOptions}; - } - else { - $callbacks = $self; - } - if (0) { # dummy to make elsif's below compile - } - elsif (defined $callbacks->{'DTDHandler'} and $method = $callbacks->{'DTDHandler'}->can('doctype_decl') ) { - my $handler = $callbacks->{'DTDHandler'}; - $self->{Methods}->{'doctype_decl'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('doctype_decl') ) { - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'doctype_decl'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'DTDHandler'} - and $callbacks->{'DTDHandler'}->can('AUTOLOAD') - and $callbacks->{'DTDHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'DTDHandler'}->doctype_decl(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'DTDHandler'}; - $self->{Methods}->{'doctype_decl'} = sub { $handler->doctype_decl(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'Handler'} - and $callbacks->{'Handler'}->can('AUTOLOAD') - and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'Handler'}->doctype_decl(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'doctype_decl'} = sub { $handler->doctype_decl(@_) }; - } - return $res; - } - else { - $self->{Methods}->{'doctype_decl'} = sub { }; - } - } - -} - -sub comment { - my $self = shift; - if (defined $self->{Methods}->{'comment'}) { - $self->{Methods}->{'comment'}->(@_); - } - else { - my $method; - my $callbacks; - if (exists $self->{ParseOptions}) { - $callbacks = $self->{ParseOptions}; - } - else { - $callbacks = $self; - } - if (0) { # dummy to make elsif's below compile - } - elsif (defined $callbacks->{'DocumentHandler'} and $method = $callbacks->{'DocumentHandler'}->can('comment') ) { - my $handler = $callbacks->{'DocumentHandler'}; - $self->{Methods}->{'comment'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'LexicalHandler'} and $method = $callbacks->{'LexicalHandler'}->can('comment') ) { - my $handler = $callbacks->{'LexicalHandler'}; - $self->{Methods}->{'comment'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('comment') ) { - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'comment'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'DocumentHandler'} - and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') - and $callbacks->{'DocumentHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'DocumentHandler'}->comment(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'DocumentHandler'}; - $self->{Methods}->{'comment'} = sub { $handler->comment(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'LexicalHandler'} - and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') - and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'LexicalHandler'}->comment(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'LexicalHandler'}; - $self->{Methods}->{'comment'} = sub { $handler->comment(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'Handler'} - and $callbacks->{'Handler'}->can('AUTOLOAD') - and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'Handler'}->comment(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'comment'} = sub { $handler->comment(@_) }; - } - return $res; - } - else { - $self->{Methods}->{'comment'} = sub { }; - } - } - -} - -sub end_entity { - my $self = shift; - if (defined $self->{Methods}->{'end_entity'}) { - $self->{Methods}->{'end_entity'}->(@_); - } - else { - my $method; - my $callbacks; - if (exists $self->{ParseOptions}) { - $callbacks = $self->{ParseOptions}; - } - else { - $callbacks = $self; - } - if (0) { # dummy to make elsif's below compile - } - elsif (defined $callbacks->{'LexicalHandler'} and $method = $callbacks->{'LexicalHandler'}->can('end_entity') ) { - my $handler = $callbacks->{'LexicalHandler'}; - $self->{Methods}->{'end_entity'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('end_entity') ) { - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'end_entity'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'LexicalHandler'} - and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') - and $callbacks->{'LexicalHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'LexicalHandler'}->end_entity(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'LexicalHandler'}; - $self->{Methods}->{'end_entity'} = sub { $handler->end_entity(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'Handler'} - and $callbacks->{'Handler'}->can('AUTOLOAD') - and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'Handler'}->end_entity(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'end_entity'} = sub { $handler->end_entity(@_) }; - } - return $res; - } - else { - $self->{Methods}->{'end_entity'} = sub { }; - } - } - -} - -sub warning { - my $self = shift; - if (defined $self->{Methods}->{'warning'}) { - $self->{Methods}->{'warning'}->(@_); - } - else { - my $method; - my $callbacks; - if (exists $self->{ParseOptions}) { - $callbacks = $self->{ParseOptions}; - } - else { - $callbacks = $self; - } - if (0) { # dummy to make elsif's below compile - } - elsif (defined $callbacks->{'ErrorHandler'} and $method = $callbacks->{'ErrorHandler'}->can('warning') ) { - my $handler = $callbacks->{'ErrorHandler'}; - $self->{Methods}->{'warning'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'Handler'} and $method = $callbacks->{'Handler'}->can('warning') ) { - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'warning'} = sub { $method->($handler, @_) }; - return $method->($handler, @_); - } - elsif (defined $callbacks->{'ErrorHandler'} - and $callbacks->{'ErrorHandler'}->can('AUTOLOAD') - and $callbacks->{'ErrorHandler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'ErrorHandler'}->warning(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'ErrorHandler'}; - $self->{Methods}->{'warning'} = sub { $handler->warning(@_) }; - } - return $res; - } - elsif (defined $callbacks->{'Handler'} - and $callbacks->{'Handler'}->can('AUTOLOAD') - and $callbacks->{'Handler'}->can('AUTOLOAD') ne (UNIVERSAL->can('AUTOLOAD') || '') - ) - { - my $res = eval { $callbacks->{'Handler'}->warning(@_) }; - if ($@) { - die $@; - } - else { - # I think there's a buggette here... - # if the first call throws an exception, we don't set it up right. - # Not fatal, but we might want to address it. - my $handler = $callbacks->{'Handler'}; - $self->{Methods}->{'warning'} = sub { $handler->warning(@_) }; - } - return $res; - } - else { - $self->{Methods}->{'warning'} = sub { }; - } - } - -} - -#-------------------------------------------------------------------# -# Class->new(%options) -#-------------------------------------------------------------------# -sub new { - my $proto = shift; - my $class = ref($proto) || $proto; - my $options = ($#_ == 0) ? shift : { @_ }; - - unless ( defined( $options->{Handler} ) or - defined( $options->{ContentHandler} ) or - defined( $options->{DTDHandler} ) or - defined( $options->{DocumentHandler} ) or - defined( $options->{LexicalHandler} ) or - defined( $options->{ErrorHandler} ) or - defined( $options->{DeclHandler} ) ) { - - $options->{Handler} = XML::SAX::Base::NoHandler->new; - } - - my $self = bless $options, $class; - # turn NS processing on by default - $self->set_feature('http://xml.org/sax/features/namespaces', 1); - return $self; -} -#-------------------------------------------------------------------# - -#-------------------------------------------------------------------# -# $p->parse(%options) -#-------------------------------------------------------------------# -sub parse { - my $self = shift; - my $parse_options = $self->get_options(@_); - local $self->{ParseOptions} = $parse_options; - if ($self->{Parent}) { # calling parse on a filter for some reason - return $self->{Parent}->parse($parse_options); - } - else { - my $method; - if (defined $parse_options->{Source}{CharacterStream} and $method = $self->can('_parse_characterstream')) { - warn("parse charstream???\n"); - return $method->($self, $parse_options->{Source}{CharacterStream}); - } - elsif (defined $parse_options->{Source}{ByteStream} and $method = $self->can('_parse_bytestream')) { - return $method->($self, $parse_options->{Source}{ByteStream}); - } - elsif (defined $parse_options->{Source}{String} and $method = $self->can('_parse_string')) { - return $method->($self, $parse_options->{Source}{String}); - } - elsif (defined $parse_options->{Source}{SystemId} and $method = $self->can('_parse_systemid')) { - return $method->($self, $parse_options->{Source}{SystemId}); - } - else { - die "No _parse_* routine defined on this driver (If it is a filter, remember to set the Parent property. If you call the parse() method, make sure to set a Source. You may want to call parse_uri, parse_string or parse_file instead.) [$self]"; - } - } -} -#-------------------------------------------------------------------# - -#-------------------------------------------------------------------# -# $p->parse_file(%options) -#-------------------------------------------------------------------# -sub parse_file { - my $self = shift; - my $file = shift; - return $self->parse_uri($file, @_) if ref(\$file) eq 'SCALAR'; - my $parse_options = $self->get_options(@_); - $parse_options->{Source}{ByteStream} = $file; - return $self->parse($parse_options); -} -#-------------------------------------------------------------------# - -#-------------------------------------------------------------------# -# $p->parse_uri(%options) -#-------------------------------------------------------------------# -sub parse_uri { - my $self = shift; - my $file = shift; - my $parse_options = $self->get_options(@_); - $parse_options->{Source}{SystemId} = $file; - return $self->parse($parse_options); -} -#-------------------------------------------------------------------# - -#-------------------------------------------------------------------# -# $p->parse_string(%options) -#-------------------------------------------------------------------# -sub parse_string { - my $self = shift; - my $string = shift; - my $parse_options = $self->get_options(@_); - $parse_options->{Source}{String} = $string; - return $self->parse($parse_options); -} -#-------------------------------------------------------------------# - -#-------------------------------------------------------------------# -# get_options -#-------------------------------------------------------------------# -sub get_options { - my $self = shift; - - if (@_ == 1) { - return { %$self, %{$_[0]} }; - } else { - return { %$self, @_ }; - } -} -#-------------------------------------------------------------------# - -#-------------------------------------------------------------------# -# get_features -#-------------------------------------------------------------------# -sub get_features { - return ( - 'http://xml.org/sax/features/external-general-entities' => undef, - 'http://xml.org/sax/features/external-parameter-entities' => undef, - 'http://xml.org/sax/features/is-standalone' => undef, - 'http://xml.org/sax/features/lexical-handler' => undef, - 'http://xml.org/sax/features/parameter-entities' => undef, - 'http://xml.org/sax/features/namespaces' => 1, - 'http://xml.org/sax/features/namespace-prefixes' => 0, - 'http://xml.org/sax/features/string-interning' => undef, - 'http://xml.org/sax/features/use-attributes2' => undef, - 'http://xml.org/sax/features/use-locator2' => undef, - 'http://xml.org/sax/features/validation' => undef, - - 'http://xml.org/sax/properties/dom-node' => undef, - 'http://xml.org/sax/properties/xml-string' => undef, - ); -} -#-------------------------------------------------------------------# - -#-------------------------------------------------------------------# -# get_feature -#-------------------------------------------------------------------# -sub get_feature { - my $self = shift; - my $feat = shift; - - # check %FEATURES to see if it's there, and return it if so - # throw XML::SAX::Exception::NotRecognized if it's not there - # throw XML::SAX::Exception::NotSupported if it's there but we - # don't support it - - my %features = $self->get_features(); - if (exists $features{$feat}) { - my %supported = map { $_ => 1 } $self->supported_features(); - if ($supported{$feat}) { - return $self->{__PACKAGE__ . "::Features"}{$feat}; - } - throw XML::SAX::Exception::NotSupported( - Message => "The feature '$feat' is not supported by " . ref($self), - Exception => undef, - ); - } - throw XML::SAX::Exception::NotRecognized( - Message => "The feature '$feat' is not recognized by " . ref($self), - Exception => undef, - ); -} -#-------------------------------------------------------------------# - -#-------------------------------------------------------------------# -# set_feature -#-------------------------------------------------------------------# -sub set_feature { - my $self = shift; - my $feat = shift; - my $value = shift; - # check %FEATURES to see if it's there, and set it if so - # throw XML::SAX::Exception::NotRecognized if it's not there - # throw XML::SAX::Exception::NotSupported if it's there but we - # don't support it - - my %features = $self->get_features(); - if (exists $features{$feat}) { - my %supported = map { $_ => 1 } $self->supported_features(); - if ($supported{$feat}) { - return $self->{__PACKAGE__ . "::Features"}{$feat} = $value; - } - throw XML::SAX::Exception::NotSupported( - Message => "The feature '$feat' is not supported by " . ref($self), - Exception => undef, - ); - } - throw XML::SAX::Exception::NotRecognized( - Message => "The feature '$feat' is not recognized by " . ref($self), - Exception => undef, - ); -} -#-------------------------------------------------------------------# - -#-------------------------------------------------------------------# -# get_handler and friends -#-------------------------------------------------------------------# -sub get_handler { - my $self = shift; - my $handler_type = shift; - $handler_type ||= 'Handler'; - return defined( $self->{$handler_type} ) ? $self->{$handler_type} : undef; -} - -sub get_document_handler { - my $self = shift; - return $self->get_handler('DocumentHandler', @_); -} - -sub get_content_handler { - my $self = shift; - return $self->get_handler('ContentHandler', @_); -} - -sub get_dtd_handler { - my $self = shift; - return $self->get_handler('DTDHandler', @_); -} - -sub get_lexical_handler { - my $self = shift; - return $self->get_handler('LexicalHandler', @_); -} - -sub get_decl_handler { - my $self = shift; - return $self->get_handler('DeclHandler', @_); -} - -sub get_error_handler { - my $self = shift; - return $self->get_handler('ErrorHandler', @_); -} - -sub get_entity_resolver { - my $self = shift; - return $self->get_handler('EntityResolver', @_); -} -#-------------------------------------------------------------------# - -#-------------------------------------------------------------------# -# set_handler and friends -#-------------------------------------------------------------------# -sub set_handler { - my $self = shift; - my ($new_handler, $handler_type) = reverse @_; - $handler_type ||= 'Handler'; - $self->{Methods} = {} if $self->{Methods}; - $self->{$handler_type} = $new_handler; - $self->{ParseOptions}->{$handler_type} = $new_handler; - return 1; -} - -sub set_document_handler { - my $self = shift; - return $self->set_handler('DocumentHandler', @_); -} - -sub set_content_handler { - my $self = shift; - return $self->set_handler('ContentHandler', @_); -} -sub set_dtd_handler { - my $self = shift; - return $self->set_handler('DTDHandler', @_); -} -sub set_lexical_handler { - my $self = shift; - return $self->set_handler('LexicalHandler', @_); -} -sub set_decl_handler { - my $self = shift; - return $self->set_handler('DeclHandler', @_); -} -sub set_error_handler { - my $self = shift; - return $self->set_handler('ErrorHandler', @_); -} -sub set_entity_resolver { - my $self = shift; - return $self->set_handler('EntityResolver', @_); -} - -#-------------------------------------------------------------------# - -#-------------------------------------------------------------------# -# supported_features -#-------------------------------------------------------------------# -sub supported_features { - my $self = shift; - # Only namespaces are required by all parsers - return ( - 'http://xml.org/sax/features/namespaces', - ); -} -#-------------------------------------------------------------------# - -sub no_op { - # this space intentionally blank -} - - -package XML::SAX::Base::NoHandler; - -# we need a fake handler that doesn't implement anything, this -# simplifies the code a lot (though given the recent changes, -# it may be better to do without) -sub new { - #warn "no handler called\n"; - return bless {}; -} - -1; - -__END__ - -=head1 NAME - -XML::SAX::Base - Base class SAX Drivers and Filters - -=head1 SYNOPSIS - - package MyFilter; - use XML::SAX::Base; - @ISA = ('XML::SAX::Base'); - -=head1 DESCRIPTION - -This module has a very simple task - to be a base class for PerlSAX -drivers and filters. It's default behaviour is to pass the input directly -to the output unchanged. It can be useful to use this module as a base class -so you don't have to, for example, implement the characters() callback. - -The main advantages that it provides are easy dispatching of events the right -way (ie it takes care for you of checking that the handler has implemented -that method, or has defined an AUTOLOAD), and the guarantee that filters -will pass along events that they aren't implementing to handlers downstream -that might nevertheless be interested in them. - -=head1 WRITING SAX DRIVERS AND FILTERS - -Writing SAX Filters is tremendously easy: all you need to do is -inherit from this module, and define the events you want to handle. A -more detailed explanation can be found at -http://www.xml.com/pub/a/2001/10/10/sax-filters.html. - -Writing Drivers is equally simple. The one thing you need to pay -attention to is B to call events yourself (this applies to Filters -as well). For instance: - - package MyFilter; - use base qw(XML::SAX::Base); - - sub start_element { - my $self = shift; - my $data = shift; - # do something - $self->{Handler}->start_element($data); # BAD - } - -The above example works well as precisely that: an example. But it has -several faults: 1) it doesn't test to see whether the handler defines -start_element. Perhaps it doesn't want to see that event, in which -case you shouldn't throw it (otherwise it'll die). 2) it doesn't check -ContentHandler and then Handler (ie it doesn't look to see that the -user hasn't requested events on a specific handler, and if not on the -default one), 3) if it did check all that, not only would the code be -cumbersome (see this module's source to get an idea) but it would also -probably have to check for a DocumentHandler (in case this were SAX1) -and for AUTOLOADs potentially defined in all these packages. As you can -tell, that would be fairly painful. Instead of going through that, -simply remember to use code similar to the following instead: - - package MyFilter; - use base qw(XML::SAX::Base); - - sub start_element { - my $self = shift; - my $data = shift; - # do something to filter - $self->SUPER::start_element($data); # GOOD (and easy) ! - } - -This way, once you've done your job you hand the ball back to -XML::SAX::Base and it takes care of all those problems for you! - -Note that the above example doesn't apply to filters only, drivers -will benefit from the exact same feature. - -=head1 METHODS - -A number of methods are defined within this class for the purpose of -inheritance. Some probably don't need to be overridden (eg parse_file) -but some clearly should be (eg parse). Options for these methods are -described in the PerlSAX2 specification available from -http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/~checkout~/perl-xml/libxml-perl/doc/sax-2.0.html?rev=HEAD&content-type=text/html. - -=over 4 - -=item * parse - -The parse method is the main entry point to parsing documents. Internally -the parse method will detect what type of "thing" you are parsing, and -call the appropriate method in your implementation class. Here is the -mapping table of what is in the Source options (see the Perl SAX 2.0 -specification for the meaning of these values): - - Source Contains parse() calls - =============== ============= - CharacterStream (*) _parse_characterstream($stream, $options) - ByteStream _parse_bytestream($stream, $options) - String _parse_string($string, $options) - SystemId _parse_systemid($string, $options) - -However note that these methods may not be sensible if your driver class -is not for parsing XML. An example might be a DBI driver that generates -XML/SAX from a database table. If that is the case, you likely want to -write your own parse() method. - -Also note that the Source may contain both a PublicId entry, and an -Encoding entry. To get at these, examine $options->{Source} as passed -to your method. - -(*) A CharacterStream is a filehandle that does not need any encoding -translation done on it. This is implemented as a regular filehandle -and only works under Perl 5.7.2 or higher using PerlIO. To get a single -character, or number of characters from it, use the perl core read() -function. To get a single byte from it (or number of bytes), you can -use sysread(). The encoding of the stream should be in the Encoding -entry for the Source. - -=item * parse_file, parse_uri, parse_string - -These are all convenience variations on parse(), and in fact simply -set up the options before calling it. You probably don't need to -override these. - -=item * get_options - -This is a convenience method to get options in SAX2 style, or more -generically either as hashes or as hashrefs (it returns a hashref). -You will probably want to use this method in your own implementations -of parse() and of new(). - -=item * get_feature, set_feature - -These simply get and set features, and throw the -appropriate exceptions defined in the specification if need be. - -If your subclass defines features not defined in this one, -then you should override these methods in such a way that they check for -your features first, and then call the base class's methods -for features not defined by your class. An example would be: - - sub get_feature { - my $self = shift; - my $feat = shift; - if (exists $MY_FEATURES{$feat}) { - # handle the feature in various ways - } - else { - return $self->SUPER::get_feature($feat); - } - } - -Currently this part is unimplemented. - - -=item * set_handler - -This method takes a handler type (Handler, ContentHandler, etc.) and a -handler object as arguments, and changes the current handler for that -handler type, while taking care of resetting the internal state that -needs to be reset. This allows one to change a handler during parse -without running into problems (changing it on the parser object -directly will most likely cause trouble). - -=item * set_document_handler, set_content_handler, set_dtd_handler, set_lexical_handler, set_decl_handler, set_error_handler, set_entity_resolver - -These are just simple wrappers around the former method, and take a -handler object as their argument. Internally they simply call -set_handler with the correct arguments. - -=item * get_handler - -The inverse of set_handler, this method takes a an optional string containing a handler type (DTDHandler, -ContentHandler, etc. 'Handler' is used if no type is passed). It returns a reference to the object that implements -that that class, or undef if that handler type is not set for the current driver/filter. - -=item * get_document_handler, get_content_handler, get_dtd_handler, get_lexical_handler, get_decl_handler, -get_error_handler, get_entity_resolver - -These are just simple wrappers around the get_handler() method, and take no arguments. Internally -they simply call get_handler with the correct handler type name. - -=back - -It would be rather useless to describe all the methods that this -module implements here. They are all the methods supported in SAX1 and -SAX2. In case your memory is a little short, here is a list. The -apparent duplicates are there so that both versions of SAX can be -supported. - -=over 4 - -=item * start_document - -=item * end_document - -=item * start_element - -=item * start_document - -=item * end_document - -=item * start_element - -=item * end_element - -=item * characters - -=item * processing_instruction - -=item * ignorable_whitespace - -=item * set_document_locator - -=item * start_prefix_mapping - -=item * end_prefix_mapping - -=item * skipped_entity - -=item * start_cdata - -=item * end_cdata - -=item * comment - -=item * entity_reference - -=item * notation_decl - -=item * unparsed_entity_decl - -=item * element_decl - -=item * attlist_decl - -=item * doctype_decl - -=item * xml_decl - -=item * entity_decl - -=item * attribute_decl - -=item * internal_entity_decl - -=item * external_entity_decl - -=item * resolve_entity - -=item * start_dtd - -=item * end_dtd - -=item * start_entity - -=item * end_entity - -=item * warning - -=item * error - -=item * fatal_error - -=back - -=head1 TODO - - - more tests - - conform to the "SAX Filters" and "Java and DOM compatibility" - sections of the SAX2 document. - -=head1 AUTHOR - -Kip Hampton (khampton@totalcinema.com) did most of the work, after porting -it from XML::Filter::Base. - -Robin Berjon (robin@knowscape.com) pitched in with patches to make it -usable as a base for drivers as well as filters, along with other patches. - -Matt Sergeant (matt@sergeant.org) wrote the original XML::Filter::Base, -and patched a few things here and there, and imported it into -the XML::SAX distribution. - -=head1 SEE ALSO - -L - -=cut - - -=head1 COPYRIGHT - -=for COPYRIGHT BEGIN - -Copyright 2022 University of Southampton. -EPrints 3.4 is supplied by EPrints Services. - -http://www.eprints.org/eprints-3.4/ - -=for COPYRIGHT END - -=for LICENSE BEGIN - -This file is part of EPrints 3.4 L. - -EPrints 3.4 and this file are released under the terms of the -GNU Lesser General Public License version 3 as published by -the Free Software Foundation unless otherwise stated. - -EPrints 3.4 is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -See the GNU Lesser General Public License for more details. - -You should have received a copy of the GNU Lesser General Public -License along with EPrints 3.4. -If not, see L. - -=for LICENSE END - diff --git a/perl_lib/XML/SAX/Exception.pm b/perl_lib/XML/SAX/Exception.pm deleted file mode 100644 index 6d3cf26..0000000 --- a/perl_lib/XML/SAX/Exception.pm +++ /dev/null @@ -1,157 +0,0 @@ -package XML::SAX::Exception; - -use strict; - -use overload '""' => "stringify", - 'fallback' => 1; - -use vars qw/$StackTrace $VERSION/; -$VERSION = '1.01'; -use Carp; - -$StackTrace = $ENV{XML_DEBUG} || 0; - -# Other exception classes: - -@XML::SAX::Exception::NotRecognized::ISA = ('XML::SAX::Exception'); -@XML::SAX::Exception::NotSupported::ISA = ('XML::SAX::Exception'); -@XML::SAX::Exception::Parse::ISA = ('XML::SAX::Exception'); - - -sub throw { - my $class = shift; - if (ref($class)) { - die $class; - } - die $class->new(@_); -} - -sub new { - my $class = shift; - my %opts = @_; - confess "Invalid options: " . join(', ', keys %opts) unless exists $opts{Message}; - - bless { ($StackTrace ? (StackTrace => stacktrace()) : ()), %opts }, - $class; -} - -sub stringify { - my $self = shift; - local $^W; - my $error; - if (exists $self->{LineNumber}) { - $error = $self->{Message} . " [Ln: " . $self->{LineNumber} . - ", Col: " . $self->{ColumnNumber} . "]"; - } - else { - $error = $self->{Message}; - } - if ($StackTrace) { - $error .= stackstring($self->{StackTrace}); - } - $error .= "\n"; - return $error; -} - -sub stacktrace { - my $i = 2; - my @fulltrace; - while (my @trace = caller($i++)) { - my %hash; - @hash{qw(Package Filename Line)} = @trace[0..2]; - push @fulltrace, \%hash; - } - return \@fulltrace; -} - -sub stackstring { - my $stacktrace = shift; - my $string = "\nFrom:\n"; - foreach my $current (@$stacktrace) { - $string .= $current->{Filename} . " Line: " . $current->{Line} . "\n"; - } - return $string; -} - -1; - -__END__ - -=head1 NAME - -XML::SAX::Exception - Exception classes for XML::SAX - -=head1 SYNOPSIS - - throw XML::SAX::Exception::NotSupported( - Message => "The foo feature is not supported", - ); - -=head1 DESCRIPTION - -This module is the base class for all SAX Exceptions, those defined in -the spec as well as those that one may create for one's own SAX errors. - -There are three subclasses included, corresponding to those of the SAX -spec: - - XML::SAX::Exception::NotSupported - XML::SAX::Exception::NotRecognized - XML::SAX::Exception::Parse - -Use them wherever you want, and as much as possible when you encounter -such errors. SAX is meant to use exceptions as much as possible to -flag problems. - -=head1 CREATING NEW EXCEPTION CLASSES - -All you need to do to create a new exception class is: - - @XML::SAX::Exception::MyException::ISA = ('XML::SAX::Exception') - -The given package doesn't need to exist, it'll behave correctly this -way. If your exception refines an existing exception class, then you -may also inherit from that instead of from the base class. - -=head1 THROWING EXCEPTIONS - -This is as simple as exemplified in the SYNOPSIS. In fact, there's -nothing more to know. All you have to do is: - - throw XML::SAX::Exception::MyException( Message => 'Something went wrong' ); - -and voila, you've thrown an exception which can be caught in an eval block. - -=cut - - -=head1 COPYRIGHT - -=for COPYRIGHT BEGIN - -Copyright 2022 University of Southampton. -EPrints 3.4 is supplied by EPrints Services. - -http://www.eprints.org/eprints-3.4/ - -=for COPYRIGHT END - -=for LICENSE BEGIN - -This file is part of EPrints 3.4 L. - -EPrints 3.4 and this file are released under the terms of the -GNU Lesser General Public License version 3 as published by -the Free Software Foundation unless otherwise stated. - -EPrints 3.4 is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -See the GNU Lesser General Public License for more details. - -You should have received a copy of the GNU Lesser General Public -License along with EPrints 3.4. -If not, see L. - -=for LICENSE END - -- 2.52.0 From 524a57c2f0edcfff6d81eda78c9155329f56d143 Mon Sep 17 00:00:00 2001 From: David R Newman Date: Thu, 5 Nov 2026 17:41:09 +0000 Subject: [PATCH 2/3] XXE protection update (#630) * Adds further protection against XXE during imports * Remove out-of-date XML libraries and standardise to XML::LibXML * Remove no longer required EPrints libraries for XML::DOM and XML::GDOME --- .../plugins/EPrints/Plugin/Import/XSLT.pm | 2 +- perl_lib/EPrints/XML.pm | 8 +- perl_lib/EPrints/XML/DOM.pm | 336 ------------------ perl_lib/EPrints/XML/GDOME.pm | 319 ----------------- perl_lib/EPrints/XML/LibXML.pm | 2 +- 5 files changed, 5 insertions(+), 662 deletions(-) delete mode 100644 perl_lib/EPrints/XML/DOM.pm delete mode 100644 perl_lib/EPrints/XML/GDOME.pm diff --git a/flavours/pub_lib/plugins/EPrints/Plugin/Import/XSLT.pm b/flavours/pub_lib/plugins/EPrints/Plugin/Import/XSLT.pm index 15c6621..a48b284 100644 --- a/flavours/pub_lib/plugins/EPrints/Plugin/Import/XSLT.pm +++ b/flavours/pub_lib/plugins/EPrints/Plugin/Import/XSLT.pm @@ -46,7 +46,7 @@ sub input_fh # read the source XML # note: LibXSLT will only work with LibXML, so that's what we use here - my $source = XML::LibXML->new->parse_fh( $fh ); + my $source = XML::LibXML->new( expand_entities => 0, load_ext_dtd => 0 )->parse_fh( $fh ); # transform it using our stylesheet my $result = $self->transform( $source ); diff --git a/perl_lib/EPrints/XML.pm b/perl_lib/EPrints/XML.pm index 29aad54..f69948b 100644 --- a/perl_lib/EPrints/XML.pm +++ b/perl_lib/EPrints/XML.pm @@ -22,7 +22,7 @@ B - XML Abstraction Module $doc = $xml->parse_string( $string, %opts ); $doc = $xml->parse_file( $filename, %opts ); - $doc = $xml->parse_url( $url ); + $doc = $xml->parse_url( $url, $no_expand ); $utf8_string = $xml->to_string( $dom_node, %opts ); @@ -43,10 +43,8 @@ B - XML Abstraction Module =head1 DESCRIPTION -EPrints can use either XML::DOM, XML::LibXML or XML::GDOME modules to generate -and process XML. Some of the functionality of these modules differs so this -module abstracts such functionality so that all the module specific code is in -one place. +EPrints has been standardised to only use the XML::LibXML module for generating/parsing XML. +For compatibility reasons this abstraction class has been retained. =head1 METHODS diff --git a/perl_lib/EPrints/XML/DOM.pm b/perl_lib/EPrints/XML/DOM.pm deleted file mode 100644 index dafd221..0000000 --- a/perl_lib/EPrints/XML/DOM.pm +++ /dev/null @@ -1,336 +0,0 @@ -###################################################################### -# -# EPrints::XML::DOM -# -###################################################################### -# -# -###################################################################### - - -=pod - -=head1 NAME - -B - DOM subs for EPrints::XML - -=head1 DESCRIPTION - -This module is not a package, it's a set of subroutines to be -loaded into EPrints::XML namespace if we're using XML::DOM - -=over 4 - -=cut - -require XML::DOM; -use XML::Parser; -# DOM runs really slowly if it checks all it's data is -# valid... -$XML::DOM::SafeMode = 0; - -XML::DOM::setTagCompression( \&_xmldom_tag_compression ); - -$EPrints::XML::CLASS = "EPrints::XML::DOM"; - -$EPrints::XML::LIB_LEN = length("XML::DOM::"); - -# DOM spec fixes -*XML::DOM::Document::documentElement = \&XML::DOM::Document::getDocumentElement; -*XML::DOM::Document::setDocumentElement = sub { - my( $self, $node ) = @_; - $self->removeChild( $self->documentElement ) if $self->documentElement; - $self->appendChild( $node ); - }; -*XML::DOM::Node::ownerDocument = \&XML::DOM::Node::getOwnerDocument; -*XML::DOM::Node::attributes = sub { - my $attrs = shift->getAttributes(@_); - return wantarray ? (map { $attrs->item( $_ ) } 0..($attrs->getLength-1) ) : $attrs; -}; -*XML::DOM::Node::nodeName = sub { shift->getNodeName(@_) }; -*XML::DOM::Node::nodeValue = sub { shift->getNodeValue(@_) }; -*XML::DOM::Node::nodeType = sub { shift->getNodeType(@_) }; -*XML::DOM::Node::prefix = sub { - my $name = shift->getNodeName(@_); - $name =~ s/^(.*)://; - return $1 || ''; - }; -*XML::DOM::Node::localName = sub { - my $name = shift->getNodeName(@_); - $name =~ s/^.*://; - return $name; - }; -*XML::DOM::Node::parentNode = sub { shift->getParentNode(@_) }; -*XML::DOM::Attr::name = \&XML::DOM::Attr::getName; -*XML::DOM::Attr::nodeName = \&XML::DOM::Attr::getName; -*XML::DOM::Attr::value = \&XML::DOM::Attr::getValue; -*XML::DOM::Attr::nodeValue = \&XML::DOM::Attr::getValue; -*XML::DOM::Element::tagName = \&XML::DOM::Element::getTagName; -*XML::DOM::NamedNodeMap::length = \&XML::DOM::NamedNodeMap::getLength; -*XML::DOM::NodeList::length = \&XML::DOM::NodeList::getLength; -*XML::DOM::Element::hasAttribute = sub { defined(shift->getAttributeNode(@_)) }; -*XML::DOM::Node::childNodes = \&XML::DOM::Node::getChildNodes; -*XML::DOM::Node::firstChild = \&XML::DOM::Node::getFirstChild; -*XML::DOM::Document::importNode = sub { - my( $doc, $node, $deep ) = @_; - - $node = $node->cloneNode( $deep ); - $node->setOwnerDocument( $doc ); - - return $node; - }; -*XML::DOM::Element::getAttributeNodeNS = sub { - my( $node, $nsuri, $name ) = @_; - - foreach my $attr ($node->attributes) - { - if( $attr->nodeName eq $name ) - { - return $attr; - } - } - - return undef; - }; - -###################################################################### -# -# EPrints::XML::_xmldom_tag_compression( $tag, $elem ) -# -# Only used by the DOM module. -# -###################################################################### - -sub _xmldom_tag_compression -{ - my ($tag, $elem) = @_; - - # Print empty br, hr and img tags like this:
- foreach my $ctag ( @EPrints::XML::COMPRESS_TAGS ) - { - return 2 if( $ctag eq $tag ); - } - - # Print other empty tags like this: - return 1; -} - -sub parse_xml_string -{ - my( $string ) = @_; - - my $doc; - my( %c ) = ( - Namespaces => 1, - ParseParamEnt => 1, - ErrorContext => 2, - NoLWP => 1 ); - $c{ParseParamEnt} = 0; - my $parser = XML::DOM::Parser->new( %c ); - - $doc = eval { $parser->parse( $string ); }; - if( $@ ) - { - my $err = $@; - $err =~ s# at /.*##; - $err =~ s#\sXML::Parser::Expat.*$##s; - print STDERR "Error parsing XML $string"; - return; - } - return $doc; -} - -sub _parse_url -{ - my( $url, $no_expand ) = @_; - - my( %c ) = ( - Namespaces => 1, - ParseParamEnt => 1, - ErrorContext => 2, - ); - if( $no_expand ) - { - $c{ParseParamEnt} = 0; - } - my $parser = XML::DOM::Parser->new( %c ); - - my $doc = $parser->parsefile( $url ); - - return $doc; -} - -sub parse_xml -{ - my( $file, $basepath, $no_expand ) = @_; - - unless( -r $file ) - { - EPrints::abort( "Can't read XML file: '$file'" ); - } - - my( %c ) = ( - Base => $basepath, - Namespaces => 1, - ParseParamEnt => 1, - ErrorContext => 2, - NoLWP => 1 ); - if( $no_expand ) - { - $c{ParseParamEnt} = 0; - } - my $parser = XML::DOM::Parser->new( %c ); - - unless( open( XML, $file ) ) - { - print STDERR "Error opening XML file: $file\n"; - return; - } - my $doc = eval { $parser->parse( *XML ); }; - close XML; - - if( $@ ) - { - my $err = $@; - $err =~ s# at /.*##; - print STDERR "Error parsing XML $file ($err)"; - return; - } - - return $doc; -} - -=item event_parse( $fh, $handler ) - -Parses the XML from filehandle $fh, calling the appropriate events -in the handler where necessary. - -=cut - -sub event_parse -{ - my( $fh, $handler ) = @_; - - my $parser = new XML::Parser( - Style => "Subs", - ErrorContext => 5, - Handlers => { - Start => sub { - my( $p, $v, %a ) = @_; - my $attr = {}; - foreach my $k ( keys %a ) - { - my( $prefix, $localname ) = split /:/, $k; - ($prefix,$localname) = ('',$prefix) if !$localname; - $attr->{'{}'.$k} = { Prefix=>$prefix, LocalName=>$localname, Name=>$k, Value=>$a{$k} }; - } - my( $prefix, $localname ) = split /:/, $v; - ($prefix,$localname) = ('',$prefix) if !$localname; - $handler->start_element( { Prefix=>$prefix, LocalName=>$localname, Name=>$v, Attributes=>$attr } ); - }, - End => sub { - my( $p, $v ) = @_; - my( $prefix, $localname ) = split /:/, $v; - ($prefix,$localname) = ('',$prefix) if !$localname; - $handler->end_element( { Prefix=>$prefix, LocalName=>$localname, Name=>$v } ); - }, - Char => sub { - my( $p, $data ) = @_; - $handler->characters( { Data=>$data } ); - }, - } ); - - $parser->parse( $fh ); -} - - -sub _dispose -{ - my( $node ) = @_; - - if( !$node->isa( "XML::DOM::Node" ) ) - { - EPrints::abort "attempt to dispose an dom node which isn't a dom node"; - } - - $node->dispose; -} - - -sub clone_and_own -{ - my( $node, $doc, $deep ) = @_; - - my $newnode; - $deep = 0 unless defined $deep; - - # XML::DOM - $newnode = $node->cloneNode( $deep ); - $newnode->setOwnerDocument( $doc ); - - return $newnode; -} - -# ignores encoding! -sub document_to_string -{ - my( $doc, $enc ) = @_; - - my $xml = $doc->toString; - utf8::decode($xml); - - return $xml; -} - -sub make_document -{ - # no params - - my $doc = new XML::DOM::Document(); - - return $doc; -} - -sub version -{ - "XML::DOM $XML::DOM::VERSION ".$INC{'XML/DOM.pm'}; -} - -package EPrints::XML::DOM; - -our @ISA = qw( EPrints::XML ); - -use strict; - -1; - -=head1 COPYRIGHT - -=for COPYRIGHT BEGIN - -Copyright 2022 University of Southampton. -EPrints 3.4 is supplied by EPrints Services. - -http://www.eprints.org/eprints-3.4/ - -=for COPYRIGHT END - -=for LICENSE BEGIN - -This file is part of EPrints 3.4 L. - -EPrints 3.4 and this file are released under the terms of the -GNU Lesser General Public License version 3 as published by -the Free Software Foundation unless otherwise stated. - -EPrints 3.4 is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -See the GNU Lesser General Public License for more details. - -You should have received a copy of the GNU Lesser General Public -License along with EPrints 3.4. -If not, see L. - -=for LICENSE END - diff --git a/perl_lib/EPrints/XML/GDOME.pm b/perl_lib/EPrints/XML/GDOME.pm deleted file mode 100644 index 77c936b..0000000 --- a/perl_lib/EPrints/XML/GDOME.pm +++ /dev/null @@ -1,319 +0,0 @@ -###################################################################### -# -# EPrints::XML::GDOME -# -###################################################################### -# -# -###################################################################### - - -=pod - -=head1 NAME - -B - GDOME subs for EPrints::XML - -=head1 DESCRIPTION - -This module is not a package, it's a set of subroutines to be -loaded into EPrints::XML namespace if we're using XML::GDOME - -=over 4 - -=cut - -require XML::GDOME; -use XML::Parser; - -$EPrints::XML::CLASS = "EPrints::XML::GDOME"; - -$EPrints::XML::LIB_LEN = length("XML::GDOME::"); - -# DOM spec fixes -*XML::GDOME::Attr::localName = sub { - my $name = shift->getNodeName(@_); - $name =~ s/^.*://; - return $name; - }; - -*XML::GDOME::Document::setDocumentElement = sub { - my( $self, $node ) = @_; - $node->parentNode->removeChild( $node ); - $self->appendChild( $node ); - }; - -# Need to clone children for DocumentFragment::cloneNode -*XML::GDOME::DocumentFragment::cloneNode = sub { - my( $self, $deep ) = @_; - - $deep = 0 if !defined $deep; - - my $f = $self->ownerDocument->createDocumentFragment; - for($self->childNodes) - { - $f->appendChild( $_->cloneNode( $deep ) ); - } - - return $f; - }; - -sub parse_xml_string -{ - my( $string ) = @_; - - my $doc; - # For some reason the GDOME constants give an error, - # using their values instead (could cause a problem if - # they change in a subsequent version). - - my $opts = 8; #GDOME_LOAD_COMPLETE_ATTRS - #unless( $no_expand ) - #{ - #$opts += 4; #GDOME_LOAD_SUBSTITUTE_ENTITIES - #} - $doc = XML::GDOME->createDocFromString( $string, $opts ); - - return $doc; -} - -sub _parse_url -{ - my( $url, $no_expand ) = @_; - - my $opts = 8; #GDOME_LOAD_COMPLETE_ATTRS - unless( $no_expand ) - { - $opts += 4; #GDOME_LOAD_SUBSTITUTE_ENTITIES - } - my $doc = XML::GDOME->createDocFromURI( "$url", $opts ); - - return $doc; -} - -sub parse_xml -{ - my( $file, $basepath, $no_expand ) = @_; - - unless( -r $file ) - { - EPrints::abort( "Can't read XML file: '$file'" ); - } - - my $tmpfile = $file; - if( defined $basepath ) - { - $tmpfile =~ s#/#_#g; - $tmpfile = $basepath."/".$tmpfile; - symlink( $file, $tmpfile ); - } - - # For some reason the GDOME constants give an error, - # using their values instead (could cause a problem if - # they change in a subsequent version). - - my $opts = 8; #GDOME_LOAD_COMPLETE_ATTRS - unless( $no_expand ) - { - $opts += 4; #GDOME_LOAD_SUBSTITUTE_ENTITIES - } - my $doc = XML::GDOME->createDocFromURI( $tmpfile, $opts ); - if( defined $basepath ) - { - unlink( $tmpfile ); - } - return $doc; -} - -=item event_parse( $fh, $handler ) - -Parses the XML from filehandle $fh, calling the appropriate events -in the handler where necessary. - -=cut - -sub event_parse -{ - my( $fh, $handler ) = @_; - - my $parser = new XML::Parser( - Style => "Subs", - ErrorContext => 5, - Handlers => { - Start => sub { - my( $p, $v, %a ) = @_; - my $attr = {}; - foreach my $k ( keys %a ) - { - my( $prefix, $localname ) = split /:/, $k; - ($prefix,$localname) = ('',$prefix) if !$localname; - $attr->{'{}'.$k} = { Prefix=>$prefix, LocalName=>$localname, Name=>$k, Value=>$a{$k} }; - } - my( $prefix, $localname ) = split /:/, $v; - ($prefix,$localname) = ('',$prefix) if !$localname; - $handler->start_element( { Prefix=>$prefix, LocalName=>$localname, Name=>$v, Attributes=>$attr } ); - }, - End => sub { - my( $p, $v ) = @_; - my( $prefix, $localname ) = split /:/, $v; - ($prefix,$localname) = ('',$prefix) if !$localname; - $handler->end_element( { Prefix=>$prefix, LocalName=>$localname, Name=>$v } ); - }, - Char => sub { - my( $p, $data ) = @_; - $handler->characters( { Data=>$data } ); - }, - } ); - - $parser->parse( $fh ); -} - - -sub _dispose -{ - my( $node ) = @_; -} - -sub clone_and_own -{ - my( $node, $doc, $deep ) = @_; - - if( !defined $node ) - { - EPrints::abort( "no node passed to clone_and_own" ); - } - - my $newnode; - $deep = 0 unless defined $deep; - - # XML::GDOME - if( is_dom( $node, "DocumentFragment" ) ) - { - $newnode = $doc->createDocumentFragment; - - if( $deep ) - { - foreach my $c ( $node->getChildNodes ) - { - $newnode->appendChild( - $doc->importNode( $c, 1 ) ); - } - } - } - else - { - $newnode = $doc->importNode( $node, $deep ); - # bug in importNode NOT being deep that it does - # not appear to clone attributes, so lets work - # around it! - - my $attrs = $node->getAttributes; - if( $attrs ) - { - for my $i ( 0..$attrs->getLength-1 ) - { - my $attr = $attrs->item( $i ); - my $k = $attr->getName; - my $v = $attr->getValue; - $newnode->setAttribute( $k, $v ); - } - } - } - - return $newnode; -} - -sub document_to_string -{ - my( $doc, $enc ) = @_; - - my $xml = $doc->toStringEnc( $enc ); - utf8::decode($xml); - - return $xml; -} - -sub make_document -{ - # no params - - my $doc = XML::GDOME->createDocument( undef, "thing", undef ); - $doc->removeChild( $doc->getFirstChild ); - - return $doc; -} - -sub version -{ - "XML::GDOME $XML::GDOME::VERSION ".$INC{'XML/GDOME.pm'}; -} - -package EPrints::XML::GDOME; - -our @ISA = qw( EPrints::XML ); - -use strict; - -sub clone_node -{ - my( $self, $node ) = @_; - - # backwards compatibility - if( !$self->isa( "EPrints::XML" ) ) - { - my $deep = $node; - $node = $self; - return EPrints::XML::clone_and_own( $node, $node->ownerDocument, $deep ); - } - - return EPrints::XML::clone_and_own( $node, $self->{doc}, 0 ); -} - -sub to_string -{ - if( !$_[0]->isa( "EPrints::XML" ) ) - { - return &_to_string; - } - - my( $self, $node, %opts ) = @_; - - # XML:GDOME::Node doesn't support indenting - my $string = $node->toString(); - utf8::decode($string) unless utf8::is_utf8($string); - - return $string; -} - -1; - -=head1 COPYRIGHT - -=for COPYRIGHT BEGIN - -Copyright 2022 University of Southampton. -EPrints 3.4 is supplied by EPrints Services. - -http://www.eprints.org/eprints-3.4/ - -=for COPYRIGHT END - -=for LICENSE BEGIN - -This file is part of EPrints 3.4 L. - -EPrints 3.4 and this file are released under the terms of the -GNU Lesser General Public License version 3 as published by -the Free Software Foundation unless otherwise stated. - -EPrints 3.4 is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -See the GNU Lesser General Public License for more details. - -You should have received a copy of the GNU Lesser General Public -License along with EPrints 3.4. -If not, see L. - -=for LICENSE END - diff --git a/perl_lib/EPrints/XML/LibXML.pm b/perl_lib/EPrints/XML/LibXML.pm index 695de55..4de5a70 100644 --- a/perl_lib/EPrints/XML/LibXML.pm +++ b/perl_lib/EPrints/XML/LibXML.pm @@ -109,7 +109,7 @@ sub _parse_url my $parser = $PARSER; if ( $no_expand ) { - $parser = XML::LibXML->new; + $parser = XML::LibXML->new( expand_entities => 0, load_ext_dtd => 0 ); } return $parser->parse_file( "$url" ) if substr( $url, 0, 6 ) ne "https:"; -- 2.52.0 From 6f8abdc38c1d49c6d586821a53c1f2ac45b3e97e Mon Sep 17 00:00:00 2001 From: "David R Newman (EPrints 3.4 development)" Date: Sun, 8 Nov 2026 09:51:31 +0000 Subject: [PATCH 3/3] Remove tests of deprecated XML libraries --- tests/10_xml_dom.pl | 62 ------------------------------------------- tests/10_xml_gdome.pl | 61 ------------------------------------------ 2 files changed, 123 deletions(-) delete mode 100644 tests/10_xml_dom.pl delete mode 100644 tests/10_xml_gdome.pl diff --git a/tests/10_xml_dom.pl b/tests/10_xml_dom.pl deleted file mode 100644 index c57ec1f..0000000 --- a/tests/10_xml_dom.pl +++ /dev/null @@ -1,62 +0,0 @@ -use strict; -use Test::More; - -BEGIN { - eval "require XML::DOM"; - if( $@ ) - { - plan skip_all => "XML::DOM missing"; - } - else - { - plan tests => 12; - } -} - -use EPrints::SystemSettings; -$EPrints::SystemSettings::conf->{enable_gdome} = 0; -$EPrints::SystemSettings::conf->{enable_libxml} = 0; -use_ok( "EPrints" ); -use_ok( "EPrints::Test" ); -use_ok( "EPrints::Test::XML" ); -$EPrints::XML::CLASS = $EPrints::XML::CLASS; # suppress used-only-once warning -BAIL_OUT( "Didn't load expected XML library" ) - if $EPrints::XML::CLASS ne "EPrints::XML::DOM"; - -my $repo = EPrints::Test::get_test_repository(); - -&EPrints::Test::XML::xml_tests( $repo ); - -ok(1); - - -=head1 COPYRIGHT - -=for COPYRIGHT BEGIN - -Copyright 2022 University of Southampton. -EPrints 3.4 is supplied by EPrints Services. - -http://www.eprints.org/eprints-3.4/ - -=for COPYRIGHT END - -=for LICENSE BEGIN - -This file is part of EPrints 3.4 L. - -EPrints 3.4 and this file are released under the terms of the -GNU Lesser General Public License version 3 as published by -the Free Software Foundation unless otherwise stated. - -EPrints 3.4 is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -See the GNU Lesser General Public License for more details. - -You should have received a copy of the GNU Lesser General Public -License along with EPrints 3.4. -If not, see L. - -=for LICENSE END - diff --git a/tests/10_xml_gdome.pl b/tests/10_xml_gdome.pl deleted file mode 100644 index f3afd20..0000000 --- a/tests/10_xml_gdome.pl +++ /dev/null @@ -1,61 +0,0 @@ -use strict; -use Test::More; - -BEGIN { - eval "require XML::GDOME"; - if( $@ ) - { - plan skip_all => "XML::GDOME missing"; - } - else - { - plan tests => 12; - } -} - -use EPrints::SystemSettings; -$EPrints::SystemSettings::conf->{enable_gdome} = 1; -$EPrints::SystemSettings::conf->{enable_libxml} = 0; -use_ok( "EPrints" ); -use_ok( "EPrints::Test" ); -use_ok( "EPrints::Test::XML" ); -$EPrints::XML::CLASS = $EPrints::XML::CLASS; # suppress used-only-once warning -BAIL_OUT( "Didn't load expected XML library" ) - if $EPrints::XML::CLASS ne "EPrints::XML::GDOME"; - -my $repo = EPrints::Test::get_test_repository(); - -&EPrints::Test::XML::xml_tests( $repo ); - -ok(1); - -=head1 COPYRIGHT - -=for COPYRIGHT BEGIN - -Copyright 2022 University of Southampton. -EPrints 3.4 is supplied by EPrints Services. - -http://www.eprints.org/eprints-3.4/ - -=for COPYRIGHT END - -=for LICENSE BEGIN - -This file is part of EPrints 3.4 L. - -EPrints 3.4 and this file are released under the terms of the -GNU Lesser General Public License version 3 as published by -the Free Software Foundation unless otherwise stated. - -EPrints 3.4 is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -See the GNU Lesser General Public License for more details. - -You should have received a copy of the GNU Lesser General Public -License along with EPrints 3.4. -If not, see L. - -=for LICENSE END - -- 2.52.0