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


line stmt bran cond sub pod time code
1              
2             package DateTime::Event::Chinese;
3 1     1   251827 use strict;
  1         2  
  1         35  
4 1     1   5 use warnings;
  1         2  
  1         31  
5 1     1   4 use vars qw($VERSION);
  1         5  
  1         47  
6             BEGIN
7             {
8 1     1   21 $VERSION = '1.00';
9             }
10 1     1   417 use DateTime::Astro qw(MEAN_SYNODIC_MONTH new_moon_after new_moon_before moment);
  0            
  0            
11             use DateTime::Event::SolarTerm qw(WINTER_SOLSTICE prev_term_at no_major_term_on);
12             use Math::Round qw(round);
13             use Exporter 'import';
14              
15             our @EXPORT_OK = qw(
16             chinese_new_years
17             chinese_new_year_for_sui
18             chinese_new_year_after
19             chinese_new_year_before
20             chinese_new_year_for_gregorian_year
21             );
22              
23              
24             # [1] p.253
25             sub chinese_new_year_for_sui {
26             my ($dt) = @_;
27              
28             return $dt if $dt->is_infinite;
29             my $s1 = prev_term_at( $dt, WINTER_SOLSTICE );
30             my $s2 = prev_term_at( $s1 + DateTime::Duration->new(days => 370), WINTER_SOLSTICE );
31              
32             my $m12 = new_moon_after( $s1 + DateTime::Duration->new(days => 1) );
33             my $m13 = new_moon_after( $m12 + DateTime::Duration->new(days => 1) );
34             my $next_m11 = new_moon_before( $s2 + DateTime::Duration->new(days => 1) );
35              
36             my $rv;
37             if (round((moment($next_m11) - moment($m12)) / MEAN_SYNODIC_MONTH) == 12 &&
38             (no_major_term_on($m12) or
39             no_major_term_on($m13))) {
40              
41             $rv = new_moon_after( $m13 );
42             } else {
43             $rv = $m13;
44             }
45              
46             return $rv;
47             }
48              
49             sub chinese_new_years {
50             return DateTime::Set->from_recurrence(
51             next => sub {
52             return $_[0] if $_[0]->is_infinite;
53             chinese_new_year_after($_[0]);
54             },
55             previous => sub {
56             return $_[0] if $_[0]->is_infinite;
57             chinese_new_year_before($_[0]);
58             }
59             );
60             }
61              
62             # [1] p.253
63             sub chinese_new_year_before {
64             my ($dt) = @_;
65             return $dt if $dt->is_infinite;
66              
67             my $new_year = chinese_new_year_for_sui($dt);
68             my $rv;
69             if ($dt > $new_year) {
70             $rv = $new_year;
71             } else {
72             $rv = chinese_new_year_for_sui($dt - DateTime::Duration->new(days => 180));
73             }
74             return $rv;
75             }
76              
77             # [1] p.260
78             sub chinese_new_year_for_gregorian_year {
79             my ($dt) = @_;
80             return $dt if $dt->is_infinite;
81              
82             return chinese_new_year_before(
83             DateTime->new(
84             year => $dt->year,
85             month => 7,
86             day => 1,
87             time_zone => $dt->time_zone
88             )
89             );
90             }
91              
92             # This one didn't exist in [1]. Basically, it just tries to get the
93             # chinese new year in the given year, and if that is before the given
94             # date, we get next year's.
95             sub chinese_new_year_after {
96             my ($dt) = @_;
97             return $dt if $dt->is_infinite;
98             my $new_year_this_gregorian_year = chinese_new_year_for_gregorian_year($dt);
99             my $rv;
100             if ($new_year_this_gregorian_year > $dt) {
101             $rv = $new_year_this_gregorian_year;
102             } else {
103             $rv = chinese_new_year_before(
104             DateTime->new(
105             year => $dt->year + 1,
106             month => 7,
107             day => 1,
108             time_zone => $dt->time_zone
109             )
110             );
111             }
112             return $rv;
113             }
114              
115             1;
116              
117             __END__