File Coverage

blib/lib/TEI/Lite/Header.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::Header;

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

require 5.006;

use strict;
use warnings;

use Date::Calc;
use XML::LibXML;
use TEI::Lite::Element;

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

our $VERSION = "0.60";

our %METHOD = (
	'setAuthor'					=>	'//teiHeader/fileDesc/titleStmt/author',
	'setAuthority'				=>	'//teiHeader/fileDesc/publicationStmt' .
									'/authority',
	'setBibliographicCitation'	=>	'//teiHeader/fileDesc/sourceDesc/bibl',
	'setDistributor'			=>	'//teiHeader/fileDesc/publicationStmt' .
									'/distributor',
	'setFunder'					=>	'//teiHeader/fileDesc/titleStmt/funder',
	'setPrincipalResearcher'	=>	'//teiHeader/fileDesc/titleStmt/principal',
	'setPublisher'				=>	'//teiHeader/fileDesc/publicationStmt' .
									'/publisher',
	'setSponsor'				=>	'//teiHeader/fileDesc/titleStmt/sponsor',
	'setTitle'					=>	'//teiHeader/fileDesc/titleStmt/title'
);

no strict "refs";

## Loop through each element in the common method hash and build the
## associated methods.  Not all methods are of the cookie cutter variety,
## so we define those methods down below.
foreach my $method ( keys( %METHOD ) )
{
	*{ $method } = sub {
			my( $self, @data ) = @_;

			## Use XPath to search for the node that we need.
			my( $node ) = $self->_ensure_xpath( $METHOD{ $method } );

			## Grab the last part of the XPath expression.
			$METHOD{ $method } =~ /\/(\w+)$/;

			## Generate the correct function name ....
			my $tei_function = "tei_$1";

			## Generate the element.
			my $element = &$tei_function( {}, @data );

			## Replace the node.
			$node->replaceNode( $element );

			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;
	## We will use an anonymous hash as the base of the object.
	my $self = _generate_header_template( @_ );
	## 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 );
	## Send it back to the caller all happy like.
	return( $self );
}

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

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

##----------------------------------------------##
##  appendRevisionEntry                         ##
##----------------------------------------------##
sub appendRevisionEntry
{
	my( $self, $date, $name, $title, @data ) = @_;

	## Attempt to decode the date ...
	my( $year, $month, $day ) = Decode_Date_US( $date );

	## Use XPath to search for the node that we need.
	my( $node ) = $self->_ensure_xpath( '//teiHeader/revisionDesc/' );

	my $element = tei_change( tei_date( { value => "$year-$month-$day" },
										Date_to_Text( $year, $month, $day ) ),
							  tei_respStmt( {}, tei_name( {}, $name ),
									  			tei_resp( {}, $title ) ),
							  map( tei_item( {}, $_ ), @data ) );

	if( $node->hasChildNodes() )
	{
		## We want our latest changes to be at the top.
		$node->insertBefore( $element, $node->firstChild );
	}
	else
	{
		## No children exist, so just append it.
		$node->appendChild( $element );
	}

	return( $node );
}

##----------------------------------------------##
##  setDatePublished                            ##
##----------------------------------------------##
sub setDatePublished
{
	my( $self, $date ) = @_;

	## Attempt to decode the data ...
	my( $year, $month, $day ) = Decode_Date_US( $date );

	## Use XPath to search for the node that we need.
	my( $node ) =
		$self->_ensure_xpath( '//teiHeader/fileDesc/publicationStmt/date' );

	my $element = tei_date( { value => "$year-$month-$day" },
							Date_to_Text( $year, $month, $day ) );

	$node->replaceNode( $element );

	return( $node );
}

##----------------------------------------------##
##  setDocumentAvailability                     ##
##----------------------------------------------##
sub setDocumentAvailability
{
	my( $self, $status, $copyright ) = @_;

	## If we don't have a status provided, set it to unknown.
	$status = "unknown" if !defined( $status );

	## Use XPath to search for the node that we need.
	my( $node ) =
		$self->_ensure_xpath( '//teiHeader/fileDesc/publicationStmt/idno' );

	my $element = tei_availability( { status => $status }, $copyright );

	$node->replaceNode( $element );

	return( $node );
}

##----------------------------------------------##
##  setIdentificationNumber                     ##
##----------------------------------------------##
sub setIdentificationNumber
{
	my( $self, $type, $number ) = @_;

	## If we don't provide a specific type, then set it to unknown.
	$type = "unknown" if !defined( $type );

	## Use XPath to search for the node that we need.
	my( $node ) =
		$self->_ensure_xpath( '//teiHeader/fileDesc/publicationStmt/idno' );

	my $element = tei_idno( { type => $type }, $number );

	$node->replaceNode( $element );

	return( $node );
}

##----------------------------------------------##
##  setKeywords                                 ##
##----------------------------------------------##
sub setKeywords
{
	my( $self, @data ) = @_;

	## Create a variable to temporarily hold our keywords.
	my @keywords;

	## Use XPath to search for the node that we need.
	my( $node ) =
		$self->_ensure_xpath( '//teiHeader/profileDesc/textClass/keywords' );

	## We need to generate *.
	my $element = tei_keywords( {},
								tei_list( {},
										  map( tei_item( {}, $_ ), @data ) ) );

	$node->replaceNode( $element );

	return( $node );
}

##==================================================================##
##  Internal Function(s)                                            ##
##==================================================================##

##----------------------------------------------##
##  _ensure_xpath                               ##
##----------------------------------------------##
##  Recursive function that will build up the   ##
##  path that is required by an element.        ##
##----------------------------------------------##
sub _ensure_xpath
{
	my( $self, $xpath ) = @_;

	## Variable that will hold our search patch after we build it and
	## also a temp variable for a loop down below.
	my( @search, $last );

	$xpath =~ s/^\/\///g;

	## Break up the XPath statement.
	my @path = split( /\//, $xpath );

	for( my $loop = 0; $loop < scalar( @path ); $loop++ )
	{
		$search[ $loop ] = "/";

		foreach( my $loop2 = 0; $loop2 <= $loop; $loop2++ )
		{
			$search[ $loop ] .= "/" . $path[ $loop2 ];
		}
	}

	foreach( @search )
	{
		my( $node ) = $self->findnodes( $_ );

		## If it is defined then that is a good thing, but if it isn't
		## we need to create it.
		if( defined( $node ) )
		{
			$last = $node;
		}
		else
		{
			## Grab the last part of the XPath expression.
			$_ =~ /\/(\w+)$/;

			## Create an element ... add it to the node tree.
			$last = $last->appendChild( XML::LibXML::Element->new( $1 ) );
		}
	}

	return( $last );
}

##----------------------------------------------##
##  _generate_header_template                   ##
##----------------------------------------------##
##  Function to generate the most basic header  ##
##  that doesn't contain any "preset" data, yet ##
##  still be valid when validated.              ##
##----------------------------------------------##
sub _generate_header_template
{
	my( $self, %params ) = @_;

	##
	##
	##</titleStmt> </td>
</tr>

<tr>
<td  class="h" >
<a name="291">291</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> 	##<publicationStmt><publisher/><date/></publicationStmt> </td>
</tr>

<tr>
<td  class="h" >
<a name="292">292</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> 	##<sourceDesc><p/></sourceDesc> </td>
</tr>

<tr>
<td  class="h" >
<a name="293">293</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> 	##</fileDesc> </td>
</tr>

<tr>
<td  class="h" >
<a name="294">294</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> 	##</teiHeader> </td>
</tr>

<tr>
<td  class="h" >
<a name="295">295</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> 	my $header = tei_teiHeader( {}, tei_fileDesc( {},  </td>
</tr>

<tr>
<td  class="h" >
<a name="296">296</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> 												  tei_titleStmt( {},  </td>
</tr>

<tr>
<td  class="h" >
<a name="297">297</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> 														  		 tei_title() ), </td>
</tr>

<tr>
<td  class="h" >
<a name="298">298</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> 								 	tei_publicationStmt( {},  </td>
</tr>

<tr>
<td  class="h" >
<a name="299">299</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> 														 tei_publisher(), </td>
</tr>

<tr>
<td  class="h" >
<a name="300">300</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> 										 				 tei_date() ), </td>
</tr>

<tr>
<td  class="h" >
<a name="301">301</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> 								 	tei_sourceDesc( {}, tei_bibl() ) ) ); </td>
</tr>

<tr>
<td  class="h" >
<a name="302">302</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> 	 </td>
</tr>

<tr>
<td  class="h" >
<a name="303">303</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> 	return( $header ); </td>
</tr>

<tr>
<td  class="h" >
<a name="304">304</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> }		 </td>
</tr>

<tr>
<td  class="h" >
<a name="305">305</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   </td>
</tr>

<tr>
<td  class="h" >
<a name="306">306</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> ##==================================================================## </td>
</tr>

<tr>
<td  class="h" >
<a name="307">307</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> ##  End of Code                                                     ## </td>
</tr>

<tr>
<td  class="h" >
<a name="308">308</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> ##==================================================================## </td>
</tr>

<tr>
<td  class="h" >
<a name="309">309</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> 1; </td>
</tr>

<tr>
<td  class="h" >
<a name="310">310</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   </td>
</tr>

<tr>
<td  class="h" >
<a name="311">311</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> ##==================================================================## </td>
</tr>

<tr>
<td  class="h" >
<a name="312">312</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> ##  Plain Old Documentation (POD)                                   ## </td>
</tr>

<tr>
<td  class="h" >
<a name="313">313</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> ##==================================================================## </td>
</tr>

<tr>
<td  class="h" >
<a name="314">314</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   </td>
</tr>

<tr>
<td  class="h" >
<a name="315">315</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> __END__ </td>
</tr>

</table>

</body>
</html>