| 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;
|
Parent Directory
| 
Revision Log