File Coverage

blib/lib/DateTime/Calendar/CopticEthiopic.pm

Criterion	Covered	Total	%
statement	13	67	19.4
branch	0	30	0.0
condition	0	12	0.0
subroutine	4	18	22.2
pod	0	6	0.0
total	17	133	12.7

package DateTime::Calendar::CopticEthiopic;
use base (DateTime);

BEGIN
{
	require 5.000;

	use strict;
	use vars qw(
		$VERSION

		$true
		$false

		@GregorianDaysPerMonth

		$n
	);

	$VERSION = "0.13";

	($false,$true) = (0,1);

	@GregorianDaysPerMonth = ( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 );
}


#
#
#  Calender System Conversion Methods Below Here:
#
#
sub _AbsoluteToEthiopic
{
my ( $self, $absolute ) = @_;

	my  $year = quotient ( 4 * ( $absolute - $self->epoch ) + 1463, 1461 );
	my $month = 1 + quotient ( $absolute - $self->_EthiopicToAbsolute ( 1, 1, $year ), 30 );
	my   $day = ( $absolute - $self->_EthiopicToAbsolute ( 1, $month, $year ) + 1 );

	( $day, $month, $year );
}


sub fromGregorian
{
my $self = shift;

	die ( "Bogus Ethiopic Date!!" ) if ( $self->_isBogusGregorianDate ( @_ ) );

	$self->_AbsoluteToEthiopic ( $self->_GregorianToAbsolute ( @_ ) );
}


sub gregorian
{
my $self = shift;

	$self->_AbsoluteToGregorian ( $self->_EthiopicToAbsolute ( @_ ) );
}


sub _isBogusEthiopicDate
{
my $self = shift;

	my($day, $month, $year) = (@_) ? @_ : ($self->day, $self->month, $self->year);

	( !( 1 <= $day && $day <= 30 )
		|| !(  1 <= $month && $month <= 13 )
		|| ( $month ==  13 && $day > 6 )
		|| ( $month ==  13 && $day == 6 && !$self->isLeapYear )
	)
	?
	$true : $false;

}


sub _isBogusGregorianDate
{
my $self = shift;

	my($day, $month, $year) = (@_) ? @_ : ($self->day, $self->month, $self->year);

	( !( 1 <= $month && $month <= 12 )
		|| !( 1 <= $day  && $day  <= $GregorianDaysPerMonth[$month-1] )
		|| ( $day == 29  && $month == 2 && !$self->_isGregorianLeapYear($year) )
	)
	?
	$true : $false;

}


sub _EthiopicToAbsolute
{
my $self = shift;
my ( $date, $month, $year ) = ( @_ ) ? @_ : ($self->day,$self->month,$self->year);

	( $self->epoch - 1 + 365 * ( $year - 1 ) + quotient ( $year, 4 ) + 30 * ( $month - 1 ) + $date );
}


sub _GregorianYear
{
my ( $a ) = @_;

	my $b = $a - 1;
	my $c = quotient ( $b, 146097 );
	my $d =      mod ( $b, 146097 );
	my $e = quotient ( $d, 36524  );
	my $f =      mod ( $d, 36524  );
	my $g = quotient ( $f, 1461   );
	my $h =      mod ( $f, 1461   );
	my $i = quotient ( $h, 365    );
	my $j = ( 400 * $c ) + ( 100 * $e ) + ( 4 * $g ) + $i;

	( ( $e == 4 ) || ( $i == 4 ) )
	  ? $j
	  : ( $j + 1 )
	;
}


sub _AbsoluteToGregorian
{
my ( $self, $absolute ) = @_;

	my $year = _GregorianYear ( $absolute );

	my $priorDays = ( $absolute - $self->_GregorianToAbsolute ( 1, 1, $year ) );

	my $correction
	= ( $absolute < $self->_GregorianToAbsolute ( 1, 3, $year ) )
	  ? 0
	  : ( $self->_isGregorianLeapYear ( $year ) )
	    ? 1
	    : 2
	;

	my $month = quotient ( ( ( 12 * ( $priorDays + $correction ) + 373 ) / 367 ), 1 );
	my $day = $absolute - $self->_GregorianToAbsolute ( 1, $month, $year ) + 1;

	( $day, $month, $year );
}


sub _GregorianToAbsolute
{
my $self = shift;
my ( $date, $month, $year ) = ( @_ ) ? @_ : ($self->day,$self->month,$self->year);

	my $correction
	= ( $month <= 2 )
	  ? 0
	  : ( $self->_isGregorianLeapYear ( $year ) )
	    ? -1
	    : -2
	;

	my $absolute =(
		365 * ( $year - 1 )
		    + quotient ( $year - 1, 4   )
		    - quotient ( $year - 1, 100 )
		    + quotient ( $year - 1, 400 )
		    + ( 367 * $month - 362 ) / 12
			+ $correction + $date
	);

	quotient ( $absolute, 1 );
}


sub _isGregorianLeapYear
{
shift;

	(
		( ( $_[0] % 4 ) != 0 )
		|| ( ( $_[0] % 400 ) == 100 )
		|| ( ( $_[0] % 400 ) == 200 )
		|| ( ( $_[0] % 400 ) == 300 )
	)
	  ? 0
	  : 1
	;
}


#
# argument is an ethiopic year
#
sub isLeapYear
{
my $self = shift;
my ( $year ) = ( @_ ) ? shift : $self->year;

	( ( $year + 1 ) % 4 ) ? 0 : 1 ;
}


sub quotient
{
	$_ = $_[0] / $_[1];

	s/\.(.*)//;

	$_;
}


sub mod
{
	( $_[0] - $_[1] * quotient ( $_[0], $_[1] ) );
}


sub toGregorian
{
my $self = shift;

	my ($day,$month,$year) = $self->gregorian;

	new DateTime ( day => $day, month => $month, year => $year );
}


#########################################################
# Do not change this, Do not put anything below this.
# File must return "true" value at termination
1;
##########################################################

__END__