File Coverage

blib/lib/TEI/Lite/Element.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package TEI::Lite::Element;

##==================================================================##
##  Libraries and Variables                                         ##
##==================================================================##

require 5.006;
require Exporter;

use strict;
use warnings;

use XML::LibXML;
use I18N::LangTags qw( is_language_tag );

our $VERSION = "0.60";

our @EXPORT = qw( %TEI_ELEMENT );

our @ISA = qw( Exporter XML::LibXML::Element );

## Global array containing all of the global attributes of TEI Lite elements.
our @G_ATTR = qw( ana corresp id lang n next prev rend );

## Global hash that contains all of the TEI Lite elements and their
## associated attributes.
our %TEI_ELEMENT = (
	'abbr'				=>	[ 'type', 'expan' ],
	'add'				=>	[ 'place' ],
	'address'			=>	[],
	'addrLine'			=>	[],
	'anchor'			=>	[],
	'argument'			=>	[],
	'author'			=>	[],
	'authority'			=>	[],
	'availability'		=>	[ 'status' ],
	'back'				=>	[],
	'bibl'				=>	[],
	'biblFull'			=>	[],
	'biblScope'			=>	[],
	'body'				=>	[],
	'byline'			=>	[],
	'catDesc'			=>	[],
	'category'			=>	[],
	'catRef'			=>	[ 'target' ],
	'cell'				=>	[ 'role', 'cols', 'rows' ],
	'change'			=>	[],
	'cit'				=>	[],
	'classCode'			=>	[ 'scheme' ],
	'classDecl'			=>	[],
	'closer'			=>	[],
	'code'				=>	[],
	'corr'				=>	[ 'sic', 'resp', 'cert' ],
	'creation'			=>	[],
	'date'				=>	[ 'calendar', 'value' ],
	'dateline'			=>	[],
	'del'				=>	[ 'type', 'status', 'hand' ],
	'distributer'		=>	[],
	'div'				=>	[ 'type' ],
	'div0'				=>	[ 'type' ],
	'div1'				=>	[ 'type' ],
	'div2'				=>	[ 'type' ],
	'div3'				=>	[ 'type' ],
	'div4'				=>	[ 'type' ],
	'div5'				=>	[ 'type' ],
	'div6'				=>	[ 'type' ],
	'div7'				=>	[ 'type' ],
	'divGen'			=>	[ 'type' ],
	'docAuthor'			=>	[],
	'docDate'			=>	[],
	'docEdition'		=>	[],
	'docImprint'		=>	[],
	'docTitle'			=>	[],
	'edition'			=>	[],
	'editionStmt'		=>	[],
	'editor'			=>	[ 'role' ],
	'editorialDecl'		=>	[],
	'eg'				=>	[],
	'emph'				=>	[],
	'encodingDesc'		=>	[],
	'epigraph'			=>	[],
	'extent'			=>	[],
	'figDesc'			=>	[],
	'figure'			=>	[ 'entity', 'url' ],
	'fileDesc'			=>	[],
	'foreign'			=>	[],
	'formula'			=>	[ 'notation' ],
	'front'				=>	[],
	'funder'			=>	[],
	'gap'				=>	[ 'desc', 'resp' ],
	'gi'				=>	[],
	'gloss'				=>	[ 'target' ],
	'group'				=>	[],
	'head'				=>	[],
	'hi'				=>	[],
	'ident'				=>	[],
	'idno'				=>	[ 'type' ],
	'imprint'			=>	[],
	'index'				=>	[ 'level1', 'level2', 'level3',
							  'level4', 'index' ],
	'interp'			=>	[ 'type', 'value', 'resp', 'inst' ],
	'interpGrp'			=>	[],
	'item'				=>	[],
	'keywords'			=>	[ 'scheme' ],
	'kw'				=>	[],
	'l'					=>	[ 'part' ],
	'label'				=>	[],
	'langUsage'			=>	[],
	'lb'				=>	[ 'ed' ],
	'lg'				=>	[],
	'list'				=>	[ 'type' ],
	'listBibl'			=>	[],
	'mentioned'			=>	[],
	'milestone'			=>	[ 'ed', 'unit' ],
	'name'				=>	[ 'type', 'key', 'reg' ],
	'note'				=>	[ 'type', 'resp', 'place',
							  'target', 'targetEnd', 'anchored' ],
	'noteStmt'			=>	[],
	'num'				=>	[ 'type', 'value' ],
	'opener'			=>	[],
	'orig'				=>	[ 'reg', 'resp' ],
	'p'					=>	[ 'type' ],
	'pb'				=>	[],
	'principal'			=>	[],
	'profileDesc'		=>	[],
	'projectDesc'		=>	[],
	'ptr'				=>	[ 'type', 'target', 'targType',
							  'crDate', 'resp' ],
	'publicationStmt'	=>	[],
	'publisher'			=>	[],
	'pubPlace'			=>	[],
	'q'					=>	[ 'type', 'who' ],
	'ref'				=>	[ 'type', 'target', 'targType',
							  'crDate', 'resp' ],
	'refsDecl'			=>	[],
	'reg'				=>	[ 'orig', 'resp' ],
	'rendition'			=>	[],
	'resp'				=>	[],
	'respStmt'			=>	[],
	'revisionDesc'		=>	[],
	'row'				=>	[ 'role' ],
	'rs'				=>	[ 'type', 'key', 'reg' ],
	's'					=>	[ 'type' ],
	'salute'			=>	[],
	'samplingDecl'		=>	[],
	'seg'				=>	[ 'type' ],
	'series'			=>	[],
	'seriesStmt'		=>	[],
	'sic'				=>	[ 'corr', 'resp', 'cert' ],
	'signed'			=>	[],
	'soCalled'			=>	[],
	'sourceDesc'		=>	[],
	'sp'				=>	[ 'who' ],
	'speaker'			=>	[],
	'sponsor'			=>	[],
	'stage'				=>	[ 'type' ],
	'table'				=>	[ 'rows', 'cols' ],
	'tagsDecl'			=>	[],
	'tagUsage'			=>	[ 'gi', 'occurs' ],
	'taxonomy'			=>	[],
	'teiHeader'			=>	[],
	'term'				=>	[],
	'text'				=>	[],
	'textClass'			=>	[],
	'time'				=>	[ 'value' ],
	'title'				=>	[ 'type', 'level' ],
	'titlePage'			=>	[],
	'titlePart'			=>	[ 'title' ],
	'titleStmt'			=>	[],
	'trailer'			=>	[],
	'unclear'			=>	[ 'reason', 'resp' ],
	'xptr'				=>	[ 'target', 'type', 'targType', 'crDate',
							  'resp', 'doc', 'from', 'to', 'url' ],
	'xref'				=>	[ 'target', 'type', 'targType', 'crDate',
							  'resp', 'doc', 'from', 'to', 'url' ]
);

no strict "refs";

## Loop through each entry in our element hash and build a
## closure for that element.
foreach my $element ( keys( %TEI_ELEMENT ) )
{
	## Add each of these elements to the default export list.
	## I can't use the below function because of the warnings it
	## will generate.  What good is it?
	#Exporter::export_tags( "tei_$element" );
	push( @EXPORT, "tei_$element" );

	*{ "tei_$element" } = sub {
		my $attributes = shift;
		my @children = @_;

		## Need to set the type argument so the constructor knows
		## what to create.
		$$attributes{ '__type__' } = $element;

		## Call the default constructor
		my $node = TEI::Lite::Element->new( $attributes, @children );

		return( $node );
	}
}

use strict "refs";

##==================================================================##
##  Constructor(s)/Deconstructor(s)                                 ##
##==================================================================##

##----------------------------------------------##
##  new                                         ##
##----------------------------------------------##
sub new
{
	## Pull in what type of an object we will be.
	my $type = shift;
	## Pull in the parameters, $attributes should be an array ref
	## and the rest of it should be children of the element.
	my $attributes = shift;
	my @children = @_;
	## We will use an XML::LibXML::Element object as the basis for our object.
	my $self = XML::LibXML::Element->new( $$attributes{__type__} );
	## Determine what exact class we will be blessing this instance into.
	my $class = ref( $type ) || $type;
	## Bless the class for it is good [tm].
	bless( $self, $class );
	## Set the attributes of the element.
	$self->setAttributes( $attributes );
	$self->appendChildren( @children );
	## Send it back to the caller all happy like.
	return( $self );
}

##----------------------------------------------##
##  TIEARRAY                                    ##
##----------------------------------------------##
sub TIEARRAY
{
	my( $class, $self ) = @_;

	bless( $self, $class );

	return( $self );
}

##----------------------------------------------##
##  DESTROY                                     ##
##----------------------------------------------##
sub DESTROY
{
	## This is mainly a placeholder to keep things like mod_perl happy.
	return;
}

##----------------------------------------------##
##  UNTIE                                       ##
##----------------------------------------------##
sub UNTIE
{
	## This is mainly a placeholder to keep things like mod_perl happy.
	return;
}

##==================================================================##
##  Method(s)                                                       ##
##==================================================================##

##----------------------------------------------##
##  appendChildren                              ##
##----------------------------------------------##
sub appendChildren
{
	my( $self, @children ) = @_;

	## Loop through each of the children and determine what type of
	## data element they are ...
	foreach( @children )
	{
		if( ( defined( $_ ) ) && ( $_ ne "" ) )
		{
			if(	( ref ) && ( $_->isa( "XML::LibXML::Node" ) ) )
			{
				## If it is one of the items above, we should be able to
				## safely append it to our DOM tree.
				$self->appendChild( $_ );
			}
			else
			{
				## If it isn't one of the items above, assume that it is
				## text data.
				$self->appendText( $_ );
			}
		}
	}

	return;
}

##----------------------------------------------##
##  CLEAR                                       ##
##----------------------------------------------##
sub CLEAR
{
	my $self = shift;

	## Grab all the nodes of our element ...
	my @childnodes = $self->childNodes;

	## Run through all of the nodes and remove each one.
	foreach( @childnodes )
	{
		$self->removeChild( $_ );
	}

	return( $self );
}

##----------------------------------------------##
##  DELETE                                      ##
##----------------------------------------------##
sub DELETE
{
	my( $self, $index ) = @_;

	## Grab all of the nodes of our element ...
	my @childnodes = $self->childNodes;

	## Remove the requested node at $index.
	$self->removeChild( $childnodes[ $index ] );

	return;
}

##----------------------------------------------##
##  EXISTS                                      ##
##----------------------------------------------##
sub EXISTS
{
	my( $self, $index ) = @_;

	## Grab all of the nodes of our element ...
	my @childnodes = $self->childNodes;

	## Check to see if we have a node at the $index.
	if( defined( $childnodes[ $index ] ) )
	{
		return( 1 );
	}
	else
	{
		return( 0 );
	}
}

##----------------------------------------------##
##  EXTEND                                      ##
##----------------------------------------------##
sub EXTEND
{
	## We don't do anything with this in our implementataion.
	return;
}

##----------------------------------------------##
##  FETCH                                       ##
##----------------------------------------------##
sub FETCH
{
	my( $self, $index ) = @_;

	## Grab all of the nodes of our element ...
	my @childnodes = $self->childNodes;

	return( $childnodes[ $index ] );
}

##----------------------------------------------##
##  FETCHSIZE                                   ##
##----------------------------------------------##
sub FETCHSIZE
{
	my $self = shift;

	## Grab the number of elements attached to our element.
	my @childnodes = $self->childNodes;
	my $size = scalar( @childnodes );

	return( $size );
}

##----------------------------------------------##
##  POP                                         ##
##----------------------------------------------##
sub POP
{
	my $self = shift;

	## Remove the last child and return it.
	return( $self->removeChild( $self->lastChild ) );
}

##----------------------------------------------##
##  PUSH                                        ##
##----------------------------------------------##
sub PUSH
{
	my( $self, @elements ) = @_;

	## We will just call our trusty function to do the
	## pushing.
	$self->appendChildren( @elements );

	return( $self->FETCHSIZE() );
}

##----------------------------------------------##
##  setAttributes                               ##
##----------------------------------------------##
sub setAttributes
{
	my( $self, $attributes ) = @_;

	## Grab the type of element.
	my $element = $self->nodeName;

	## Loop through the global attributes and the element specific
	## attributes.
	foreach( @G_ATTR, @{ $TEI_ELEMENT{ $element } } )
	{
		## If it is defined in our attribute hash, then go ahead and
		## set it.
		if( defined( $$attributes{ $_ } ) )
		{
			$self->setAttribute( $_, $$attributes{ $_ } );
		}
	}

	return;
}

##----------------------------------------------##
##  setLang                                     ##
##----------------------------------------------##
sub setLang
{
	my( $self, $lang ) = @_;

	if( is_language_tag( $lang ) )
	{
		$self->setAttribute( "lang", $lang );
		return( 1 );
	}

	return( 0 );
}

##----------------------------------------------##
##  SHIFT                                       ##
##----------------------------------------------##
sub SHIFT
{
	my $self = shift;

	## Grab the first element, remove it and then
	## send it back to the caller.
	return( $self->removeChild( $self->firstChild ) );
}

##----------------------------------------------##
##  STORE                                       ##
##----------------------------------------------##
sub STORE
{
	my( $self, $index, $value ) = @_;

	## Grab the number of elements attached to our element.
	my @childnodes = $self->childNodes;
	my $size = scalar( @childnodes );

	## Check to see if our $index is greater then our current size.
	if( $index >= ( $size - 1 ) )
	{
		## Determine if we need to add "buffer" space to make
		## the insertion at the correct index.
		my $blanknodes = $index - $size;

		for( my $i = 0; $i < $blanknodes; $i++ )
		{
			$self->appendTextNode( " " );
		}

		## We shall call our convience function to determine if
		## the data is text or another element.
		$self->appendChildren( $value );
	}
	else
	{
		## Determine what type of node we have and take the
		## appropriate function.
		if( ( defined( $value ) ) && ( $value ne "" ) )
		{
			if( ( ref( $value ) ) && ( $value->isa( "XML::LibXML::Node" ) ) )
			{
				$childnodes[$index]->replaceNode( $value );
			}
			else
			{
				my $node = XML::LibXML::Text->new( $value );
				$childnodes[$index]->replaceNode( $node );
			}
		}
	}

	return;
}

##----------------------------------------------##
##  UNSHIFT                                     ##
##----------------------------------------------##
sub UNSHIFT
{
	my( $self, @list ) = @_;

	foreach( @list )
	{
		my $first = $self->firstChild;

		if( $_->isa( "XML::LibXML::Node" ) )
		{
			$self->insertBefore( $_, $first );
		}
		else
		{
			my $node = XML::LibXML::Text->new( $_ );
			$self->insertBefore( $node, $first );
		}
	}

	return;
}

##==================================================================##
##  Internal Functions                                              ##
##==================================================================##

##==================================================================##
##  End of Code                                                     ##
##==================================================================##
1;

##==================================================================##
##  Plain Old Documentation (POD)                                   ##
##==================================================================##

__END__