view release on metacpan or  search on metacpan

lib/DateTime/Fiction/JRRTolkien/Shire.pm  view on Meta::CPAN

    my ( $self, @arg ) = @_;
    return $self->add_duration( $self->_make_duration( @arg ) );
}

{
    my $validate = Params::ValidationCompiler::validation_for(
        name             => '_check_add_duration_params',
        name_is_optional => 1,
        params           => [
            { type => __t( 'Duration' ) },
        ],
    );

    sub add_duration {
	my ( $self, @arg ) = @_;
	my ( $dur ) = $validate->( @arg );
	return $self->_add_duration( $dur );
    }

    sub subtract_duration {
	my ( $self, @arg ) = @_;
	my ( $dur ) = $validate->( @arg );
	return $self->_add_duration( $dur->inverse() );
    }
}

{
    # The _offset arrays are accessed by
    # @xx_offset[$self->is_leap_year][$forward][$holiday];
    my @month_offset = (
	[	# Not a leap year
	    [ 0, -2, -1, -2,  0, -3, -1 ],	# Going backward
	    [ 0,  1,  3,  2,  0,  1,  2 ],	# Going forward
	],
	[	# A leap year
	    [ 0, -2, -1, -2, -3, -4, -1 ],	# Going backward
	    [ 0,  1,  4,  3,  2,  1,  2 ],	# Going forward
	],
    );
    my @week_offset = (	# Note that we only use indices 3 & 4
	[	# Not a leap year
	    [ 0, 0, 0, -1,  0, 0, 0 ],	# Going backward
	    [ 0, 0, 0,  1,  0, 0, 0 ],	# Going forward
	],
	[	# A leap year
	    [ 0, 0, 0, -1, -2, 0, 0 ],	# Going backward
	    [ 0, 0, 0,  2,  1, 0, 0 ],	# Going forward
	],
    );

    sub _add_duration {
	my ( $self, $dur ) = @_;

        # simple optimization (cribbed shamelessly from DateTime)
	$dur->is_zero()
	    and return $self;

        my %delta = $dur->deltas();

	# This bit isn't quite right since DateTime::Infinite::Future -
	# infinite duration should NaN (cribbed shamelessly from
	# DateTime)
        foreach my $val ( values %delta ) {
            my $inf;
            if ( $val == DateTime->INFINITY ) {
                $inf = DateTime::Infinite::Future->new;
            }
            elsif ( $val == DateTime->NEG_INFINITY ) {
                $inf = DateTime::Infinite::Past->new;
            }

            if ($inf) {
                %$self = %$inf;
                bless $self, ref $inf;

                return $self;
            }
        }

	$self->is_infinite()
	    and return $self;

	if ( $delta{years} || $delta{months} || $delta{weeks} ) {

	    my $forward = $dur->is_forward_mode();
	    my $holiday = $self->holiday();
	    my $leap = $self->is_leap_year();
	    my $orig_rd = my $shire_rd = ( $self->local_rd_values() )[0] +
		GREGORIAN_RATA_DIE_TO_SHIRE;

	    if ( my $months = delete $delta{months} ) {
		$shire_rd +=
		    $month_offset[$leap][$forward][$holiday];
		$holiday = 0;	# No further adjustment needed
		my ( $year, $day_of_year ) = __rata_die_to_year_day(
		    $shire_rd );
		my ( $month, $day ) = __day_of_year_to_date( $year,
		    $day_of_year );
		$month += $months - 1;	# now zero-based
		$year += POSIX::floor( $month / 12 );
		$leap = __is_leap_year( $year );
		$month = 1 + $month % 12;	# now one-based again
		$day_of_year = __date_to_day_of_year( $year, $month,
		    $day );
		$shire_rd = __year_day_to_rata_die( $year, $day_of_year );
	    }

	    if ( my $weeks = delete $delta{weeks} ) {
		$shire_rd += $week_offset[$leap][$forward][$holiday];
		my ( $year, $day_of_year ) = __rata_die_to_year_day(
		    $shire_rd );
		my ( $month, $day ) = __day_of_year_to_date( $year,
		    $day_of_year );
		my $week = __week_of_year( $month, $day );
		my $day_of_week = __day_of_week( $month, $day );
		$week += $weeks - 1;	# now zero-based
		$year += POSIX::floor( $week / 52 );
		$leap = __is_leap_year( $year );
		$week = $week % 52;
		$day_of_year = $week * 7 + $day_of_week;
		$week > 25	# Still zero-based, remember