File Coverage

blib/lib/DateTime/Event/Chinese.pm

Criterion	Covered	Total	%
statement	11	13	84.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	16	18	88.8

package DateTime::Event::Chinese;
use strict;
use warnings;
use vars qw($VERSION);
BEGIN
{
    $VERSION = '1.00';
}
use DateTime::Astro qw(MEAN_SYNODIC_MONTH new_moon_after new_moon_before moment);
use DateTime::Event::SolarTerm qw(WINTER_SOLSTICE prev_term_at no_major_term_on);
use Math::Round qw(round);
use Exporter 'import';

our @EXPORT_OK = qw(
    chinese_new_years
    chinese_new_year_for_sui
    chinese_new_year_after
    chinese_new_year_before
    chinese_new_year_for_gregorian_year
);


# [1] p.253
sub chinese_new_year_for_sui {
    my ($dt) = @_;

    return $dt if $dt->is_infinite;
    my $s1 = prev_term_at( $dt, WINTER_SOLSTICE );
    my $s2 = prev_term_at( $s1 + DateTime::Duration->new(days => 370), WINTER_SOLSTICE );

    my $m12 = new_moon_after( $s1 + DateTime::Duration->new(days => 1) );
    my $m13 = new_moon_after( $m12 + DateTime::Duration->new(days => 1) );
    my $next_m11 = new_moon_before( $s2 + DateTime::Duration->new(days => 1) );

    my $rv;
    if (round((moment($next_m11) - moment($m12)) / MEAN_SYNODIC_MONTH) == 12 &&
        (no_major_term_on($m12) or
         no_major_term_on($m13))) {

        $rv = new_moon_after( $m13 );
    } else {
        $rv = $m13;
    }

    return $rv;
}

sub chinese_new_years {
    return DateTime::Set->from_recurrence(
        next => sub {
            return $_[0] if $_[0]->is_infinite;
            chinese_new_year_after($_[0]);
        },
        previous => sub {
            return $_[0] if $_[0]->is_infinite;
            chinese_new_year_before($_[0]);
         }
    );
}

# [1] p.253
sub chinese_new_year_before {
    my ($dt) = @_;
    return $dt if $dt->is_infinite;

    my $new_year = chinese_new_year_for_sui($dt);
    my $rv;
    if ($dt > $new_year) {
        $rv = $new_year;
    } else {
        $rv = chinese_new_year_for_sui($dt - DateTime::Duration->new(days => 180));
    }
    return $rv;
}

# [1] p.260
sub chinese_new_year_for_gregorian_year {
    my ($dt) = @_;
    return $dt if $dt->is_infinite;

    return chinese_new_year_before(
        DateTime->new(
            year => $dt->year,
            month => 7,
            day => 1,
            time_zone => $dt->time_zone
        )
    );
}

# This one didn't exist in [1]. Basically, it just tries to get the
# chinese new year in the given year, and if that is before the given
# date, we get next year's.
sub chinese_new_year_after {
    my ($dt) = @_;
    return $dt if $dt->is_infinite;
    my $new_year_this_gregorian_year = chinese_new_year_for_gregorian_year($dt);
    my $rv;
    if ($new_year_this_gregorian_year > $dt) {
        $rv = $new_year_this_gregorian_year;
    } else {
        $rv = chinese_new_year_before(
            DateTime->new(
                year => $dt->year + 1,
                month => 7,
                day => 1,
                time_zone => $dt->time_zone
            )
        );
    }
    return $rv;
}

1;

__END__