line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Date::Holidays::KZ; |
2
|
|
|
|
|
|
|
our $VERSION = '0.2022.0'; # VERSION |
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
=encoding utf8 |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
=head1 NAME |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
Date::Holidays::KZ - Determine Kazakhstan official holidays and business days. |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
=head1 SYNOPSIS |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
use Date::Holidays::KZ qw( is_holiday holidays is_business_day ); |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
my ( $year, $month, $day ) = ( localtime )[ 5, 4, 3 ]; |
15
|
|
|
|
|
|
|
$year += 1900; |
16
|
|
|
|
|
|
|
$month += 1; |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
if ( my $holidayname = is_holiday( $year, $month, $day ) ) { |
19
|
|
|
|
|
|
|
print "Today is a holiday: $holidayname\n"; |
20
|
|
|
|
|
|
|
} |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
my $ref = holidays( $year ); |
23
|
|
|
|
|
|
|
while ( my ( $md, $name ) = each %$ref ) { |
24
|
|
|
|
|
|
|
print "On $md there is a holiday named $name\n"; |
25
|
|
|
|
|
|
|
} |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
if ( is_business_day( 2012, 03, 11 ) ) { |
28
|
|
|
|
|
|
|
print "2012-03-11 is business day on weekend\n"; |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
if ( is_short_business_day( 2015, 04, 30 ) ) { |
32
|
|
|
|
|
|
|
print "2015-04-30 is short business day\n"; |
33
|
|
|
|
|
|
|
} |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
$Date::Holidays::KZ::strict=1; |
36
|
|
|
|
|
|
|
# here we die because time outside from $HOLIDAYS_VALID_SINCE to $INACCURATE_TIMES_SINCE |
37
|
|
|
|
|
|
|
holidays( 9001 ); |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
=cut |
40
|
|
|
|
|
|
|
|
41
|
5
|
|
|
5
|
|
333296
|
use warnings; |
|
5
|
|
|
|
|
58
|
|
|
5
|
|
|
|
|
167
|
|
42
|
5
|
|
|
5
|
|
27
|
use strict; |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
94
|
|
43
|
5
|
|
|
5
|
|
58
|
use utf8; |
|
5
|
|
|
|
|
11
|
|
|
5
|
|
|
|
|
29
|
|
44
|
5
|
|
|
5
|
|
128
|
use base 'Exporter'; |
|
5
|
|
|
|
|
6
|
|
|
5
|
|
|
|
|
942
|
|
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
our @EXPORT_OK = qw( |
47
|
|
|
|
|
|
|
is_holiday |
48
|
|
|
|
|
|
|
is_kz_holiday |
49
|
|
|
|
|
|
|
holidays |
50
|
|
|
|
|
|
|
is_business_day |
51
|
|
|
|
|
|
|
is_short_business_day |
52
|
|
|
|
|
|
|
); |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
=head2 $Date::Holidays::KZ::HOLIDAYS_VALID_SINCE, $Date::Holidays::KZ::INACCURATE_TIMES_SINCE |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
HOLIDAYS_VALID_SINCE before this year package doesn't matter |
57
|
|
|
|
|
|
|
INACCURATE_TIMES_SINCE after this year dates of holidays and working day shift are not accurate, but you can most likely be sure of historical holidays |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
=cut |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
our $HOLIDAYS_VALID_SINCE = 2016; # TODO add all old |
62
|
|
|
|
|
|
|
our $INACCURATE_TIMES_SINCE = 2023; |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
=head2 $Date::Holidays::KZ::strict |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
Allows you to return an error if the requested date is outside the determined times. |
68
|
|
|
|
|
|
|
Default is 0. |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
=cut |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
our $strict = 0; |
73
|
|
|
|
|
|
|
|
74
|
5
|
|
|
5
|
|
32
|
use Carp; |
|
5
|
|
|
|
|
15
|
|
|
5
|
|
|
|
|
327
|
|
75
|
5
|
|
|
5
|
|
2471
|
use Time::Piece; |
|
5
|
|
|
|
|
63107
|
|
|
5
|
|
|
|
|
25
|
|
76
|
5
|
|
|
5
|
|
477
|
use List::Util qw/ first /; |
|
5
|
|
|
|
|
9
|
|
|
5
|
|
|
|
|
5341
|
|
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
# internal date formatting alike ISO 8601: MMDD |
79
|
|
|
|
|
|
|
my @REGULAR_HOLIDAYS = ( |
80
|
|
|
|
|
|
|
{ |
81
|
|
|
|
|
|
|
name => 'Новый год', |
82
|
|
|
|
|
|
|
days => [ qw( 0101 0102 ) ], |
83
|
|
|
|
|
|
|
}, |
84
|
|
|
|
|
|
|
{ |
85
|
|
|
|
|
|
|
name => 'Православное рождество', |
86
|
|
|
|
|
|
|
days => '0107', |
87
|
|
|
|
|
|
|
}, |
88
|
|
|
|
|
|
|
{ |
89
|
|
|
|
|
|
|
name => 'Международный женский день', |
90
|
|
|
|
|
|
|
days => '0308', |
91
|
|
|
|
|
|
|
}, |
92
|
|
|
|
|
|
|
{ |
93
|
|
|
|
|
|
|
name => 'Наурыз мейрамы', |
94
|
|
|
|
|
|
|
days => [ qw( 0321 0322 0323 ) ], |
95
|
|
|
|
|
|
|
}, |
96
|
|
|
|
|
|
|
{ |
97
|
|
|
|
|
|
|
name => 'Праздник единства народа Казахстана', |
98
|
|
|
|
|
|
|
days => '0501', |
99
|
|
|
|
|
|
|
}, |
100
|
|
|
|
|
|
|
{ |
101
|
|
|
|
|
|
|
name => 'День защитника Отечества', |
102
|
|
|
|
|
|
|
days => '0507', |
103
|
|
|
|
|
|
|
}, |
104
|
|
|
|
|
|
|
{ |
105
|
|
|
|
|
|
|
name => 'День Победы', |
106
|
|
|
|
|
|
|
days => '0509', |
107
|
|
|
|
|
|
|
}, |
108
|
|
|
|
|
|
|
{ |
109
|
|
|
|
|
|
|
name => 'День Столицы', |
110
|
|
|
|
|
|
|
days => '0706', |
111
|
|
|
|
|
|
|
}, |
112
|
|
|
|
|
|
|
{ |
113
|
|
|
|
|
|
|
name => 'День Конституции Республики Казахстан', |
114
|
|
|
|
|
|
|
days => '0830', |
115
|
|
|
|
|
|
|
}, |
116
|
|
|
|
|
|
|
{ |
117
|
|
|
|
|
|
|
name => 'День Первого Президента Республики Казахстан', |
118
|
|
|
|
|
|
|
days => '1201', |
119
|
|
|
|
|
|
|
}, |
120
|
|
|
|
|
|
|
{ |
121
|
|
|
|
|
|
|
name => 'День Независимости', |
122
|
|
|
|
|
|
|
days => [ qw( 1216 1217 ) ], |
123
|
|
|
|
|
|
|
}, |
124
|
|
|
|
|
|
|
# Курбан-айта goes to HOLIDAYS_SPECIAL because based on the muslim calendar |
125
|
|
|
|
|
|
|
); |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
my %HOLIDAYS_SPECIAL = ( |
128
|
|
|
|
|
|
|
2016 => [ qw( 0104 0307 0502 0510 0912 1219 ) ], |
129
|
|
|
|
|
|
|
2017 => [ qw( 0103 0320 0508 0707 0901 1218 1219 ) ], |
130
|
|
|
|
|
|
|
2018 => [ qw( 0821 0309 0508 0430 0831 1203 1218 1231 ) ], |
131
|
|
|
|
|
|
|
2019 => [ qw( 0325 0510 0708 1202 0811 ) ], |
132
|
|
|
|
|
|
|
2020 => [ qw( 0103 0309 0324 0325 0508 0831 1218 ) ], |
133
|
|
|
|
|
|
|
2021 => [ qw( 0104 0324 0503 0510 0705 0720 0910 ) ], |
134
|
|
|
|
|
|
|
2022 => [ qw( 0103 0104 0502 0510 0307 0829 1219 ) ], |
135
|
|
|
|
|
|
|
); |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
my %BUSINESS_DAYS_ON_WEEKENDS = ( |
139
|
|
|
|
|
|
|
2016 => [ qw( 0305 ) ], |
140
|
|
|
|
|
|
|
2017 => [ qw( 0318 0701 ) ], |
141
|
|
|
|
|
|
|
2018 => [ qw( 0303 0505 0825 1229 ) ], |
142
|
|
|
|
|
|
|
2019 => [ qw( 0504 ) ], |
143
|
|
|
|
|
|
|
2020 => [ qw( 0105 1220 ) ], |
144
|
|
|
|
|
|
|
2021 => [ qw( 0703 ) ], |
145
|
|
|
|
|
|
|
2022 => [ qw( 0305 0827 ) ], |
146
|
|
|
|
|
|
|
); |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
my %SHORT_BUSINESS_DAYS = ( |
149
|
|
|
|
|
|
|
); |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
=head2 is_holiday( $year, $month, $day ) |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
Determine whether this date is a KZ holiday. Returns holiday name or undef. |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
=cut |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
sub is_holiday { |
158
|
14
|
|
|
14
|
1
|
3450
|
my ( $year, $month, $day ) = @_; |
159
|
14
|
50
|
33
|
|
|
109
|
croak 'Bad params' unless $year && $month && $day; |
|
|
|
33
|
|
|
|
|
160
|
|
|
|
|
|
|
|
161
|
14
|
|
|
|
|
45
|
return holidays( $year )->{ _get_date_key($month, $day) }; |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
=head2 is_kz_holiday( $year, $month, $day ) |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
Alias for is_holiday(). |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
=cut |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
sub is_kz_holiday { |
171
|
2
|
|
|
2
|
1
|
1020
|
goto &is_holiday; |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
=head2 holidays( $year ) |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
Returns hash ref of all KZ holidays in the year. |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=cut |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
my %cache; |
181
|
|
|
|
|
|
|
sub holidays { |
182
|
16
|
50
|
|
16
|
1
|
992
|
my $year = shift or croak 'Bad year'; |
183
|
|
|
|
|
|
|
|
184
|
16
|
100
|
|
|
|
59
|
return $cache{ $year } if $cache{ $year }; |
185
|
|
|
|
|
|
|
|
186
|
9
|
|
|
|
|
35
|
my $holidays = _get_regular_holidays_by_year($year); |
187
|
|
|
|
|
|
|
|
188
|
6
|
100
|
|
|
|
25
|
if ( my $spec = $HOLIDAYS_SPECIAL{ $year } ) { |
189
|
4
|
|
|
|
|
34
|
$holidays->{ $_ } = 'Перенос праздничного дня' for @$spec; |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
|
192
|
6
|
|
|
|
|
26
|
return $cache{ $year } = $holidays; |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
sub _get_regular_holidays_by_year { |
196
|
9
|
|
|
9
|
|
22
|
my ($year) = @_; |
197
|
9
|
100
|
|
|
|
69
|
croak "KZ holidays is not valid before $HOLIDAYS_VALID_SINCE" if $year < $HOLIDAYS_VALID_SINCE; |
198
|
7
|
100
|
|
|
|
26
|
if ($strict) { |
199
|
1
|
50
|
|
|
|
5
|
croak "KZ holidays is not valid after @{[ $INACCURATE_TIMES_SINCE - 1 ]}" if $year >= $INACCURATE_TIMES_SINCE; |
|
1
|
|
|
|
|
18
|
|
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
|
202
|
6
|
|
|
|
|
13
|
my %day; |
203
|
6
|
|
|
|
|
16
|
for my $holiday (@REGULAR_HOLIDAYS) { |
204
|
66
|
|
|
|
|
123
|
my $days = _resolve_yhash_value($holiday->{days}, $year); |
205
|
66
|
50
|
|
|
|
121
|
next if !$days; |
206
|
66
|
100
|
|
|
|
128
|
$days = [$days] if !ref $days; |
207
|
66
|
50
|
|
|
|
107
|
next if !@$days; |
208
|
|
|
|
|
|
|
|
209
|
66
|
|
|
|
|
173
|
my $name = _resolve_yhash_value($holiday->{name}, $year); |
210
|
66
|
50
|
|
|
|
111
|
croak "Name is not defined" if !$name; # assertion |
211
|
|
|
|
|
|
|
|
212
|
66
|
|
|
|
|
192
|
$day{$_} = $name for @$days; |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
|
215
|
6
|
|
|
|
|
13
|
return \%day; |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
sub _resolve_yhash_value { |
219
|
132
|
|
|
132
|
|
213
|
my ($value, $year) = @_; |
220
|
132
|
50
|
|
|
|
272
|
return $value if ref $value ne 'HASH'; |
221
|
|
|
|
|
|
|
|
222
|
0
|
|
|
0
|
|
0
|
my $ykey = first {$year >= $_} reverse sort keys %$value; |
|
0
|
|
|
|
|
0
|
|
223
|
0
|
0
|
|
|
|
0
|
return if !$ykey; |
224
|
0
|
|
|
|
|
0
|
return $value->{$ykey}; |
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
=head2 is_business_day( $year, $month, $day ) |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
Returns true if date is a business day in KZ taking holidays and weekends into account. |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
=cut |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
sub is_business_day { |
235
|
5
|
|
|
5
|
1
|
142
|
my ( $year, $month, $day ) = @_; |
236
|
|
|
|
|
|
|
|
237
|
5
|
50
|
33
|
|
|
25
|
croak 'Bad params' unless $year && $month && $day; |
|
|
|
33
|
|
|
|
|
238
|
|
|
|
|
|
|
|
239
|
5
|
100
|
|
|
|
12
|
return 0 if is_holiday( $year, $month, $day ); |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
# check if date is a weekend |
242
|
4
|
|
|
|
|
18
|
my $t = Time::Piece->strptime( "$year-$month-$day", '%Y-%m-%d' ); |
243
|
4
|
|
|
|
|
250
|
my $wday = $t->day; |
244
|
4
|
100
|
100
|
|
|
80
|
return 1 unless $wday eq 'Sat' || $wday eq 'Sun'; |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
# check if date is a business day on weekend |
247
|
3
|
50
|
|
|
|
8
|
my $ref = $BUSINESS_DAYS_ON_WEEKENDS{ $year } or return 0; |
248
|
|
|
|
|
|
|
|
249
|
3
|
|
|
|
|
4
|
my $md = _get_date_key($month, $day); |
250
|
3
|
|
|
|
|
6
|
for ( @$ref ) { |
251
|
5
|
100
|
|
|
|
12
|
return 1 if $_ eq $md; |
252
|
|
|
|
|
|
|
} |
253
|
|
|
|
|
|
|
|
254
|
2
|
|
|
|
|
9
|
return 0; |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
=head2 is_short_business_day( $year, $month, $day ) |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
Returns true if date is a shortened business day in KZ. |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
=cut |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
sub is_short_business_day { |
264
|
0
|
|
|
0
|
1
|
0
|
my ( $year, $month, $day ) = @_; |
265
|
|
|
|
|
|
|
|
266
|
0
|
0
|
|
|
|
0
|
my $short_days_ref = $SHORT_BUSINESS_DAYS{ $year } or return 0; |
267
|
|
|
|
|
|
|
|
268
|
0
|
|
|
|
|
0
|
my $date_key = _get_date_key($month, $day); |
269
|
0
|
|
|
|
|
0
|
return !!grep { $_ eq $date_key } @$short_days_ref; |
|
0
|
|
|
|
|
0
|
|
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
sub _get_date_key { |
274
|
14
|
|
|
14
|
|
26
|
my ($month, $day) = @_; |
275
|
14
|
|
|
|
|
87
|
return sprintf '%02d%02d', $month, $day; |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
=head1 LICENSE |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
This software is copyright (c) 2022 by Vladimir Varlamov. |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
283
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
Terms of the Perl programming language system itself |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
a) the GNU General Public License as published by the Free |
288
|
|
|
|
|
|
|
Software Foundation; either version 1, or (at your option) any |
289
|
|
|
|
|
|
|
later version, or |
290
|
|
|
|
|
|
|
b) the "Artistic License" |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
=cut |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
=head1 AUTHOR |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
Vladimir Varlamov, C<< >> |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
=cut |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
1; |