element.pm

CCSM Research Tools: Community Atmosphere Model (CAM)

############################################################
#
# Module: XML::Lite::Element
#
# Created: 27 August 2001 by Jeremy Wadsack for Wadsack-Allen Digital Group
# Copyright (C) 2001 Wadsack-Allen. All rights reserved.
#
#	TODO
#		* firstChild, lastChild, previousSibling, nextSibling?
#		* Equivalent 'parent' method to return enclosing element.
#		* Could add to_string methods to reproduce original XML content (incl. tags) (requires that original doc be preserved!)
#		* Could add open_tag, close_tag methods to get those parts of content
#
############################################################
# Date        Modification                            Author
# ----------------------------------------------------------
# 08Sep2001 Changed ->{parent} to ->{doc}                 JW
#           Changed ->{_positions} to ->{node}            JW
############################################################
package XML::Lite::Element;

=head1 NAME

XML::Lite::Element - A class representing an XML element in an XML::Lite
document

=head1 SYNOPSIS

use XML::Lite;
my $xml = new XML::Lite( -xml => 'a_file.xml' );
my $elm = $xml->elements_by_name( 'element_name' );
print $elm->get_attribute( 'attribute_name' );

=head1 DESCRIPTION

C<XML::Lite::Element> objects contain rudimentary methods for querying XML 
elements in an XML document as parsed by XML::Lite. Usually these objects 
are returned by method calls in XML::Lite.

=head1 METHODS

The following methods are available. All methods like 'get_name' can be 
abbeviated as 'name.'

=over 4

=cut 

use strict;
BEGIN {
	use vars       qw( $VERSION @ISA );
	$VERSION = '0.11';
	@ISA         = qw();
} # end BEGIN
# non-exported package globals go here
use vars      qw();

############################
## The object constructor ##
############################

=item my $element = new XML::Lite::Element( $owner_document, \@pointers );

Creates a new XML::Lite::Element object from the XML::Lite object, C<$owner_document>.

Currently, you must not call this manually. You can create an object with one of 
the 'factory' methods in XML::Lite, such as C<element_by_name> or C<root_element> 
or with one of the XML::Lite::Element 'factory' methods below, like C<get_children>.

=cut

sub new {
	my $self = {};
	my $proto = shift;
	my $class = ref($proto) || $proto;

	# The arguments are as follows:
	#   $owner_document   is an XML::Lite object within which this element lives
	#   \@pointers        is a two or four element array ref containing the offsets
	#                     into the original document of the start and end points of 
	#                     the opening and closing (when it exists) tags for the element
	
	# Validate arguments
	return undef unless @_ >= 2;
	return undef unless ref($_[0]) && (ref($_[1]) eq 'ARRAY');
	
	# Load 'em up
	
	# The data structure for the ::Element object has these properties
	#   doc               A reference to the containing XML::Lite object
	#   node              A reference to an array of pointers to our element in the document
	#   self              A pointer to our own entry in the owner doc's tree
	#   parent            A pointer to our parent elemenet's entry in the owner doc's tree
	#   name              The name on our tag
	#   _attrs            A string of the attibutes in our tag (unparsed)
	#  attrs              A hash ref of attributes in our tag
	
	$self->{doc} = $_[0];
	$self->{node} = $_[1];
	
	# Using the pointers, find out tag name, and attribute list from the 
	# opening tag (if there are any attributes).
	my $tag = substr( $self->{doc}{doc}, $self->{node}[0], $self->{node}[1] - $self->{node}[0] + 1 );
	if( $tag =~ m{^<\s*([^/>\s]+)\s+([^>]+)\s*/?\s*>$} ) {
		$self->{name} = $1;
		$self->{_attrs} = $2;		# Store the attributes as a scalar. Parse when asked
	} elsif( $tag =~ m{^<\s*([^/>\s]+)\s*/?\s*>$} ) {
		$self->{name} = $1;
	} else {
		# Should have been caught in the parsing! maybe an assert?
		$self->{doc}->_error( 'ELM_NOT_CLOSED', $self->{node}[0] + $self->{doc}->{doc_offset} );
	} # end if
	
	# Good. Now returns it.
	bless ($self, $class);
	return $self;
} # end new


##########################
##                      ##
##   Public Methods     ##
##                      ##
##########################

=item my $content = $element->get_content()

Returns the content of the XML element. This may include other XML tags. The
entire content is returned as a scalar.

=cut

# ----------------------------------------------------------
# Date      Modification                              Author
# ----------------------------------------------------------
# 28Aug2001 Added CDATA retoration                        JW
# 06Nov2001 Added <.../> optimization                     JW
# ----------------------------------------------------------
sub content;
*content = \&get_content;
sub get_content {
	my $self = shift;

	# If we don't have any content, then we should return 
	# '' right away.
	return '' unless defined $self->{node}[2];
	
	# Using our pointers, find everything between our tags
	my $content = substr( $self->{doc}{doc}, $self->{node}[1] + 1, $self->{node}[2] - $self->{node}[1] - 1 );
	
	# Now, restore any CDATA chunks that may have been pulled out
	$content =~ s/<!\[CDATA\[(\S+)\s*\]\]\/>/<![CDATA[$self->{doc}{_CDATA}[$1]]]>/g;
	
	# And return the content
	return $content;
} # end get_content


=item my $attributes = $element->get_attributes()

Returns a hash of name - value pairs for the attributes in this element.

=cut

# ----------------------------------------------------------
# Date      Modification                              Author
# ----------------------------------------------------------
# 13Mar2002 Return empty hash if no attributes           EBK
# ----------------------------------------------------------
sub attributes;
*attributes = \&get_attributes;
sub get_attributes {
	my $self = shift;
	
	# Parse the attribute string into a hash of name-value pairs
	# unless we've already done that.
	$self->_parse_attrs() unless defined $self->{attrs};
	
	# Just return a *copy* of the hash (this is read-only after all!)
       if ( defined($self->{attrs}) ) {
		return %{$self->{attrs}};
       } else {
		my %empty;
		return %empty; 
	}

} # end get_attributes

=item my $value = $element->get_attribute( $name )

Returns the value of the named attribute for this element.

=cut

# ----------------------------------------------------------
# Date      Modification                              Author
# ----------------------------------------------------------
# ----------------------------------------------------------
sub attribute;
*attribute = \&get_attribute;
sub get_attribute {
	my $self = shift;
	my( $name ) = @_;
	
	# If we haven't parsed the attribute string into a hash, then do that.
	$self->_parse_attrs() unless defined $self->{attrs};
	
	# Now return the requested attribute. If it's not there
	# then 'undef' is returned
	return $self->{attrs}{$name};
} # end get_attribute


=item my $name = $element->get_name()

Returns the name of the element tag

=cut

# ----------------------------------------------------------
# Date      Modification                              Author
# ----------------------------------------------------------
# ----------------------------------------------------------
sub name;
*name = \&get_name;
sub get_name {
	my $self = shift;
	# Just look it up. We got this in the contructor
	return $self->{name};
} # end get_name


=item my @children = $element->get_children()

Returns a list of XML::Lite::Element objects for each element contained 
within the current element. This does not return any text or CDATA in 
the content of this element. You can parse that through the L<get_content> 
method.

If no child elements exist then an empty list is returned.

=cut

# ----------------------------------------------------------
# Date      Modification                              Author