/[suikacvs]/perl/lib/Calender/Special/JP.pm
Suika

Contents of /perl/lib/Calender/Special/JP.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (hide annotations) (download)
Mon Dec 24 08:13:56 2001 UTC (22 years, 11 months ago) by wakaba
Branch: MAIN
CVS Tags: HEAD
2001-12-24  wakaba <wakaba@suika.fam.cx>

	* M17N/: New directory.

1 wakaba 1.1
2    
3     #use base Cal::Sp;
4     package Calender::Special::JP;
5     $VERSION = '1.00';
6    
7     use Time::Local;
8    
9     sub _d {$_[0] < 1970? 0: timegm(0,0,0,$_[2],$_[1]-1,$_[0])}
10     my %d = (
11     #M6 => _d(1873,10,14), ## Meiji 6 Dajoukan Fukoku No.344
12     M12 => _d(1879,7,5), ## Meiji 12 Dajoukan Fukoku No.27
13     T1 => _d(1912,9,3), ## Taishou 1 Chokurei No.19
14     T2 => _d(1913,7,16), ## Taishou 2 Chokurei No.259
15     S2 => _d(1927,3,3), ## Shouwa 2 Chokurei No.25
16     S23 => _d(1948,7,20), ## Shouwa 23 Law No.178
17     S41 => _d(1966,6,25), ## Shouwa 41 Law No.86
18     S48 => _d(1948,7,20), ## Shouwa 48 Law No.10
19     S60 => _d(1985,12,27), ## Shouwa 60 Law No.103
20     H1 => _d(1998,2,17), ## Heisei 1 Law No.5
21     H7 => _d(1996,1,1), ## Heisei 7 Law No.22
22     H10 => _d(2000,1,1), ## Heisei 10 Law No.141
23     );
24    
25     $MONDAY = 1;
26    
27     sub isholiday {
28     my ($year, $month, $day) = @_;
29     my $time = _d($year,$month,$day);
30     my $wday = (gmtime($time))[6];
31    
32     #return 0 if $time < _d(1873,10,14); ## 1983AD = Meiji6
33     return 0 if $year < 1970;
34    
35     if ($month == 1) {
36     return 1 if $day == 1 && $d{S23} <= $time;
37     return 1 if $wday == $MONDAY && 8 <= $day && $day <= 14 &&
38     $d{H10} < $time;
39     return 1 if $wday == $MONDAY && $day == 2 && $d{S48} <= $time;
40     ## Substitute of 1/2
41    
42     return 1 if $day == 15 && $d{S23} <= $time && $time < $d{H10};
43     return 1 if $wday == $MONDAY && $day == 16 && ## Substitute
44     $d{S48} <= $time && $time < $d{H10}; ## of 1/15
45    
46     return 1 if ($day == 3 || $day == 5) && $time < $d{S23};
47     return 1 if $day == 30 && $time < $d{T1};
48     } elsif ($month == 2) {
49     return 1 if $day == 11 && ($time < $d{S23} || $d{S41} <= $time);
50     return 1 if $wday == $MONDAY && $day == 12 && $d{S48} <= $time;
51     ## Substitute of 2/11
52    
53     return 1 if $year == 1989 && $day == 24;
54     ## Funeral of the Shouwa Emperor (Heisei 1 Law No.4)
55     } elsif ($month == 3) {
56     ## !! Formaly, this method do not support before 1900AD.
57     return 1 if 1878 <= $year && $year < 3000 &&
58     $day == int($year * 0.24242 - $year / 4.0 + 35.84);
59     return 1 if $wday == $MONDAY && $d{S48} <= $time && $year < 3000 &&
60     $day == int($year * 0.24242 - $year / 4.0 + 35.84)+1;
61     ## Substitute of 3/2x
62     } elsif ($month == 4) {
63     return 1 if $day == 29 && $d{S2} <= $time;
64     return 1 if $wday == $MONDAY && $day == 30 && $d{S48} <= $time;
65     ## Substitute of 4/29
66    
67     return 1 if $time < $d{S23} && $day == 3;
68     return 1 if $year == 1959 && $day == 10;
69     ## Wedding of the Shouwa Emperor (Shouwa 34 Law No.16)
70     } elsif ($month == 5) {
71     return 1 if $day == 3 && $d{S23} <= $time;
72     return 1 if $day == 4 && $d{S60} <= $time;
73     return 1 if $day == 5 && $d{S23} <= $time;
74     return 1 if $wday == $MONDAY && ($day == 4 || $day == 6) &&
75     $d{S48} <= $time;
76     } elsif ($month == 6) {
77     return 1 if $year == 1993 && $day == 9;
78     ## Wedding of post-Heisei Emperor (Heisei 5 Law No.32)
79     } elsif ($month == 7) {
80     return 1 if $day == 20 && $d{H7} <= $time;
81     return 1 if $wday == $MONDAY && $day == 21 && $d{H7} <= $time;
82     ## Substitute of 7/20
83     return 1 if $day == 30 && $d{T1} <= $time && $time < $d{S2};
84     } elsif ($month == 8) {
85     return 1 if $day == 31 && $d{T1} <= $time && $time < $d{S2};
86     } elsif ($month == 9) {
87     return 1 if $day == 15 && $d{S41} <= $time;
88     ## !! Formaly, this method do not support before 1900AD.
89     return 1 if 1878 <= $year && $year < 3000 &&
90     $day == int($year * 0.24204 - $year / 4.0 + 39.01);
91    
92     return 1 if $wday == $MONDAY && $day == 16 && $d{S48} <= $time;
93     ## Substitute of 9/15
94     return 1 if $wday == $MONDAY && $d{S48} <= $time && $year < 3000 &&
95     $day == int($year * 0.24204 - $year / 4.0 + 39.01)+1;
96     ## Substitute of 9/2x
97    
98     return 1 if $day == 17 && $time < $d{M12};
99     } elsif ($month == 10) {
100     return 1 if $wday == $MONDAY && $day <= 8 && $day <= 14 &&
101     $d{H10} <= $time;
102    
103     return 1 if $day == 10 && $d{S41} <= $time && $time < $d{H10};
104     return 1 if $wday == $MONDAY && $day == 11 &&
105     $d{S48} <= $time && $time < $d{H10};
106     ## Substitute of 10/10
107    
108     return 1 if $day == 17 && $d{M12} <= $time && $time < $d{S23};
109     return 1 if $day == 31 && $d{T2} <= $time && $time < $d{S2};
110     } elsif ($month == 11) {
111     return 1 if $day == 3 && ($time < $d{T1} || $d{S2} <= $time);
112     return 1 if $wday == $MONDAY && $day == 4 && $d{S48} <= $time;
113     ## Substitute of 11/3
114     return 1 if $day == 23;
115     return 1 if $wday == $MONDAY && $day == 24 && $d{S48} <= $time;
116     ## Substitute of 11/23
117    
118     return 1 if ($year == 1915 || $year == 1928) &&
119     ($day == 10 || $day == 14 || $day == 16);
120     ## Imperial Ascension Rites of Taishou/Shouwa Emperor
121     ## and related celemonies
122     ## (Taishou 4 Chokurei No.161, Shouwa 3 Chokurei No.226)
123     return 1 if $year == 1990 && $day == 12;
124     ## Imperial Ascension Rites of Heisei Emperor
125     ## (Heisei 2 Law No.24)
126     } elsif ($month == 12) {
127     return 1 if $day == 23 && $d{H1} <= $time;
128     return 1 if $wday == $MONDAY && $day == 24 && $d{H1} <= $time;
129     ## Substitute of 12/24
130     return 1 if $day == 25 && $d{S2} <= $time && $time < $d{S23};
131     }
132    
133     0;
134     }
135    
136     =head1 NAME
137    
138     Calender::Special::JP --- Calender - Special: Japan
139    
140     =head1 LICENSE
141    
142     This program is free software; you can redistribute it and/or
143     modify it under the same terms as Perl itself.
144    
145     =head1 AUTHOR
146    
147     wakaba <wakaba@suika.fam.cx>
148    
149     $Id:$
150    
151     =cut
152    
153     1;

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24