###################################################################### # # EPrints::XML::DOM # ###################################################################### # # This file is part of GNU EPrints 2. # # Copyright (c) 2000-2004 University of Southampton, UK. SO17 1BJ. # # EPrints 2 is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # EPrints 2 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with EPrints 2; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # ###################################################################### =pod =head1 NAME B<EPrints::XML::DOM> - 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::PREFIX = "XML::DOM::"; # DOM spec fixes *XML::DOM::Document::documentElement = \&XML::DOM::Document::getDocumentElement; *XML::DOM::Node::ownerDocument = \&XML::DOM::Node::getOwnerDocument; *XML::DOM::Node::attributes = sub { shift->getAttributes(@_) }; *XML::DOM::Node::nodeName = sub { shift->getNodeName(@_) }; *XML::DOM::Node::nodeValue = sub { shift->getNodeValue(@_) }; *XML::DOM::Node::nodeType = sub { shift->getNodeType(@_) }; *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::Element::hasAttribute = sub { defined(shift->getAttributeNode(@_)) }; ###################################################################### # # 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: <br /> foreach my $ctag ( @EPrints::XML::COMPRESS_TAGS ) { return 2 if( $ctag eq $tag ); } # Print other empty tags like this: <empty></empty> 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_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 ) { $attr->{$k} = { Name=>$k, Value=>$a{$k} }; } $handler->start_element( { Name=>$v, Attributes=>$attr } ); }, End => sub { my( $p, $v ) = @_; $handler->end_element( { Name=>$v } ); }, Char => sub { my( $p, $data ) = @_; $handler->characters( { Data=>$data } ); }, } ); $parser->parse( $fh ); } sub dispose { my( $node ) = @_; if( !defined $node ) { EPrints::abort "attempt to dispose an undefined dom node"; } if( !EPrints::XML::is_dom( $node, "Node" ) ) { EPrints::abort "attempt to dispose an dom node which isn't a dom node"; } $node->dispose; } sub clone_node { my( $node, $deep ) = @_; if( !defined $node ) { EPrints::abort "no node passed to clone_node"; } return $node->cloneNode( $deep ); } 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 ) = @_; return $doc->toString; } sub make_document { # no params my $doc = new XML::DOM::Document(); return $doc; } sub make_document_fragment { my( $session ) = @_; return $session->{doc}->createDocumentFragment; }