File Coverage

blib/lib/Date/Decade.pm

Criterion	Covered	Total	%
statement	12	49	24.4
branch	0	18	0.0
condition	0	9	0.0
subroutine	4	10	40.0
pod	0	5	0.0
total	16	91	17.5

# Date::Decade.pm
#
# Copyright (c) 2001 Michael Diekmann . All rights
# reserved. This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

# Documentation could be found at the bottom or use (after install):
# > perldoc Date::Decade

package Date::Decade;

require 5.003_03;
require Exporter;

use strict;
use Carp;
use vars qw(@EXPORT_OK %EXPORT_TAGS @ISA $VERSION
	@arr_Days_in_Decade
);

#use Date::Pcalc 1.2 qw(
#	leap_year
#	check_date
#	Day_of_Year
#);
use Date::Calc 4.3 qw(
	leap_year
	check_date
	Day_of_Year
);

@ISA = qw(Exporter);

# we export nothing by default :)
@EXPORT_OK = qw(
	Days_in_Decade
	Decade_of_Year
	Decade_of_Month
);
%EXPORT_TAGS = (all => [@EXPORT_OK] );

@arr_Days_in_Decade = (
[ 10,10,11 , 10,10,8 , 10,10,11 , 10,10,10 , 10,10,11 , 10,10,10 , 10,10,11 , 10,10,11 , 10,10,10 , 10,10,11 , 10,10,10 , 10,10,11 ],
[ 10,10,11 , 10,10,9 , 10,10,11 , 10,10,10 , 10,10,11 , 10,10,10 , 10,10,11 , 10,10,11 , 10,10,10 , 10,10,11 , 10,10,10 , 10,10,11 ]
);

$VERSION = '0.33';

#///////////////////////////////////////////////////////////////////////#
#									#
#///////////////////////////////////////////////////////////////////////#

sub Days_in_Decade {
	my $year = shift;
	my $decade = shift;

	if ($year > 0) {
		if (($decade >= 1) && ($decade <= 36)) {
			return $arr_Days_in_Decade[leap_year($year)][$decade-1];
		}
		else {
			DATECALC_DECADE_ERROR("Days_in_Decade");
		}
	}
	else {
		DATECALC_YEAR_ERROR("Days_in_Decade");
	}
}

#///////////////////////////////////////////////////////////////////////#
#									#
#///////////////////////////////////////////////////////////////////////#

sub Decade_of_Year {
	my $year = shift;
	my $month = shift;
	my $day = shift;

	if (check_date($year, $month, $day)) {
		my $n_days = Day_of_Year($year,$month,$day);
		my $decade = _round($n_days / 10);
		if ($decade > 36) {
			$decade = 36;
		}
		elsif ($decade == 0) {
			$decade = 1;
		}
		return $decade;
	}
	else {
		DATECALC_DATE_ERROR("Decade_of_Year");
	}
}

#///////////////////////////////////////////////////////////////////////#
#									#
#///////////////////////////////////////////////////////////////////////#

sub Decade_of_Month {
	my $year = shift;
	my $month = shift;
	my $day = shift;

	if (check_date($year, $month, $day)) {
		my $decade = ($day - ($day % 10)) / 10 + 1;
		if ($decade >= 4) {
			$decade = 3;
		}
		return $decade;
	}
	else {
		DATECALC_DATE_ERROR("Decade_of_Month");
	}
}

#///////////////////////////////////////////////////////////////////////#
#									#
#///////////////////////////////////////////////////////////////////////#

sub _round {
	$_ = shift;
	my $x = int($_);
	if (($_ >= 0) && (($_ - $x) >= 0.5)) {
		$x++;
	}
	elsif (($_ < 0) && (($x - $_) >= 0.5)) {
		$x--;
	}
	return $x;
}

#///////////////////////////////////////////////////////////////////////#
#									#
#///////////////////////////////////////////////////////////////////////#

sub DATECALC_DECADE_ERROR {
	my ($name) = @_;
	croak("Date::Pcalc::${name}(): decade out of range");
}

sub DATECALC_DATE_ERROR {
	my ($name) = @_;
	croak("Date::Pcalc::${name}(): not a valid date");
}

1;

__END__