view release on metacpan or  search on metacpan

lib/DateTime/Calendar/Chinese.pm  view on Meta::CPAN

package DateTime::Calendar::Chinese;
use 5.008;
use strict;
use utf8;
use vars qw($VERSION);
BEGIN {
    $VERSION = '1.00';
}

use DateTime;
use DateTime::Astro qw(MEAN_TROPICAL_YEAR MEAN_SYNODIC_MONTH moment dt_from_moment new_moon_after new_moon_before
    solar_longitude_from_moment
);
use DateTime::Event::Chinese qw(chinese_new_year_before);
use DateTime::Event::SolarTerm qw(prev_term_at no_major_term_on);
use Params::Validate;
use Math::Round qw(round);
use constant GREGORIAN_CHINESE_EPOCH => DateTime->new(
    year => -2636, month => 2, day => 15, time_zone => 'UTC');
use constant GREGORIAN_CHINESE_EPOCH_MOMENT => moment(GREGORIAN_CHINESE_EPOCH);
use constant DEBUG => $ENV{PERL_DATETIME_CALENDAR_CHINESE_DEBUG};

my %BasicValidate = (
    cycle => {
        default => 1,
    },
    cycle_year  => {
        default   => 1,
        callbacks => {
            'is between 1 and 60' => sub { $_[0] >= 1 && $_[0] <= 60 }
        }
    },
    month => {
        default   => 1,
        callbacks => {
            'is between 1 and 12' => sub { $_[0] >= 1 && $_[0] <= 12 }
        }
    },
    leap_month => {
        default => 0,
        type => Params::Validate::BOOLEAN()
    },
    day        => {
        default   => 1,
        type => Params::Validate::SCALAR()
    },
    hour   => {
        type => Params::Validate::SCALAR(), default => 0,
        callbacks => {
            'is between 0 and 23' => sub { $_[0] >= 0 && $_[0] <= 23 },
        },
    },
    minute => {
        type => Params::Validate::SCALAR(), default => 0,
        callbacks => {
            'is between 0 and 59' => sub { $_[0] >= 0 && $_[0] <= 59 },
        },
    },
    second => {
        type => Params::Validate::SCALAR(), default => 0,
        callbacks => {
            'is between 0 and 61' => sub { $_[0] >= 0 && $_[0] <= 61 },
        },
    },
    nanosecond => {
        type => Params::Validate::SCALAR(), default => 0,
        callbacks => {
            'cannot be negative' => sub { $_[0] >= 0 },
        }
    },
    locale    => { type => Params::Validate::SCALAR() | Params::Validate::OBJECT(), optional => 1 },
    language  => { type => Params::Validate::SCALAR() | Params::Validate::OBJECT(), optional => 1 },
);

my %NewValidate = (
    %BasicValidate,
    time_zone  => { type => Params::Validate::SCALAR() | Params::Validate::OBJECT(), default => 'Asia/Shanghai' },
);
sub new
{
    my $class = shift;
    my %args  = Params::Validate::validate(@_, \%NewValidate);

    # XXX - currently _calc_gregorian_components() calculates the
    # date component only, then we set the time
    my %hash;
    $hash{cycle}      = delete $args{cycle};
    $hash{cycle_year} = delete $args{cycle_year};
    $hash{month}      = delete $args{month};
    $hash{leap_month} = delete $args{leap_month};
    $hash{day}        = delete $args{day};

    my $self  = bless \%hash, $class;
    $self->_calc_gregorian_components(time_zone => delete $args{time_zone});
    $self->{gregorian}->set(%args);

    $self;
}

# XXX - these values are proxied directly to the underlying DateTime
# (Gregorian) object.
sub utc_rd_values { $_[0]->{gregorian}->utc_rd_values }
sub hour          { $_[0]->{gregorian}->hour }
sub minute        { $_[0]->{gregorian}->minute }
sub second        { $_[0]->{gregorian}->second }
sub nanosecond    { $_[0]->{gregorian}->nanosecond }
sub day_of_week   { $_[0]->{gregorian}->day_of_week }
sub time_zone     { $_[0]->{gregorian}->time_zone }
sub set_time_zone { shift->{gregorian}->set_time_zone(@_) }

# XXX - accessors for DT::C::C specific fields
sub cycle      { $_[0]->{cycle} }
sub cycle_year { $_[0]->{cycle_year} }
sub month      { $_[0]->{month} }
sub leap_month { $_[0]->{leap_month} }
sub day        { $_[0]->{day} }

my @celestial_stems =
    ( "甲",
      "乙",
      "丙",
      "丁",
      "戊",
      "å·±",
      "庚",
      "辛",
      "壬",