Newer
Older
Digital_Repository / OARiNZ / DIY / deb_package / eprints-3.0 / perl_lib / EPrints / XML / GDOME.pm
######################################################################
#
# EPrints::XML::GDOME
#
######################################################################
#
#  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::GDOME> - 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::PREFIX = "XML::GDOME::";

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_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 ) { $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" );
	}
}


sub clone_node
{
	my( $node, $deep ) = @_;

	if( !defined $node )
	{
		EPrints::abort( "no node passed to clone_node" );
	}

	if( is_dom( $node, "DocumentFragment" ) )
	{
		my $doc = $node->getOwnerDocument;
		my $f = $doc->createDocumentFragment;
		return $f unless $deep;
		
		foreach my $c ( $node->getChildNodes )
		{
			$f->appendChild( $c->cloneNode( 1 ) );
		}
		return $f;
	}

	my $doc = $node->getOwnerDocument;
	my $newnode = $node->cloneNode( 1 );
	$doc->importNode( $newnode, 1 );

	return $newnode;
}

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 ) = @_;

	return $doc->toStringEnc( $enc );
}

sub make_document
{
	# no params

	my $doc = XML::GDOME->createDocument( undef, "thing", undef );
	$doc->removeChild( $doc->getFirstChild );

	return $doc;
}

sub make_document_fragment
{
	my( $session ) = @_;
	
	return $session->{doc}->createDocumentFragment;
}