line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#!/usr/bin/perl |
2
|
|
|
|
|
|
|
# Date::HolidayParser |
3
|
|
|
|
|
|
|
# A parser of ~/.holiday-style files. |
4
|
|
|
|
|
|
|
# The format is based off of the holiday files found bundled |
5
|
|
|
|
|
|
|
# with the plan program, not any official spec. This because no |
6
|
|
|
|
|
|
|
# official spec could be found. |
7
|
|
|
|
|
|
|
# Copyright (C) Eskild Hustvedt 2006, 2007, 2008, 2010 |
8
|
|
|
|
|
|
|
# |
9
|
|
|
|
|
|
|
# This program is free software; you can redistribute it and/or modify it |
10
|
|
|
|
|
|
|
# under the same terms as Perl itself. There is NO warranty; |
11
|
|
|
|
|
|
|
# not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. |
12
|
|
|
|
|
|
|
# |
13
|
|
|
|
|
|
|
# This is the iCalendar component, which emulates a DP::iCalendar-like interface |
14
|
|
|
|
|
|
|
# in order to make it easier to use for users familiar with iCalendar, and |
15
|
|
|
|
|
|
|
# make it compatible with DP::iCalendar::Manager. |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
package Date::HolidayParser::iCalendar; |
18
|
|
|
|
|
|
|
|
19
|
2
|
|
|
2
|
|
143092
|
use Moo; |
|
2
|
|
|
|
|
23901
|
|
|
2
|
|
|
|
|
11
|
|
20
|
2
|
|
|
2
|
|
4099
|
use Date::HolidayParser; |
|
2
|
|
|
|
|
9
|
|
|
2
|
|
|
|
|
89
|
|
21
|
2
|
|
|
2
|
|
19
|
use constant { true => 1, false => undef }; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
2701
|
|
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
our $VERSION = 0.4_2; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
extends 'Date::HolidayParser'; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
has '_UID_List' => ( |
28
|
|
|
|
|
|
|
is => 'rw', |
29
|
|
|
|
|
|
|
default => sub { {} }, |
30
|
|
|
|
|
|
|
); |
31
|
|
|
|
|
|
|
has '_iCal_cache' => ( |
32
|
|
|
|
|
|
|
is => 'rw', |
33
|
|
|
|
|
|
|
default => sub { {} }, |
34
|
|
|
|
|
|
|
); |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
# -- Public methods -- |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
# Purpose: Get an iCalendar hash with holiday info matching the supplied UID |
39
|
|
|
|
|
|
|
# Usage: get_info(UID); |
40
|
|
|
|
|
|
|
sub get_info |
41
|
|
|
|
|
|
|
{ |
42
|
72
|
|
|
72
|
1
|
144
|
my $self = shift; |
43
|
72
|
|
|
|
|
119
|
my $UID = shift; |
44
|
72
|
100
|
|
|
|
391
|
return($self->_UID_List->{$UID}) if $self->_UID_List->{$UID}; |
45
|
3
|
|
|
|
|
12
|
return(false); |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
# Purpose: List events in said year, on said month and day |
49
|
|
|
|
|
|
|
# Usage: obj->list_events(year?,month?,day?); |
50
|
|
|
|
|
|
|
# year is required, others are optional. |
51
|
|
|
|
|
|
|
# |
52
|
|
|
|
|
|
|
# This is the primary API for this module. It does only wrap the other |
53
|
|
|
|
|
|
|
# methods, but provides a cleaner interface for new code. |
54
|
|
|
|
|
|
|
sub list_events |
55
|
|
|
|
|
|
|
{ |
56
|
24
|
|
|
24
|
1
|
7522
|
my ($self,$Year,$Month,$Day) = @_; |
57
|
24
|
50
|
|
|
|
110
|
if(not defined $Year) |
58
|
|
|
|
|
|
|
{ |
59
|
0
|
|
|
|
|
0
|
croak('Requried parameter "Year" not supplied'); |
60
|
|
|
|
|
|
|
} |
61
|
24
|
100
|
|
|
|
69
|
if(defined $Day) |
|
|
100
|
|
|
|
|
|
62
|
|
|
|
|
|
|
{ |
63
|
9
|
|
|
|
|
23
|
return $self->get_timeinfo($Year,$Month,$Day,'DAY'); |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
elsif(defined $Month) |
66
|
|
|
|
|
|
|
{ |
67
|
12
|
|
|
|
|
31
|
return $self->get_monthinfo($Year,$Month); |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
else |
70
|
|
|
|
|
|
|
{ |
71
|
3
|
|
|
|
|
7
|
return $self->get_months($Year); |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
# Purpose: Get information for the supplied month (list of days there are events) |
76
|
|
|
|
|
|
|
# Usage: my $TimeRef = $object->get_monthinfo(YEAR,MONTH,DAY); |
77
|
|
|
|
|
|
|
sub get_monthinfo |
78
|
|
|
|
|
|
|
{ |
79
|
24
|
|
|
24
|
0
|
6301
|
my($self, $Year, $Month) = @_; # TODO: verify that they are set |
80
|
24
|
|
|
|
|
95
|
$self->get($Year); |
81
|
24
|
|
|
|
|
39
|
my @Array; |
82
|
24
|
50
|
33
|
|
|
125
|
if(defined($self->_iCal_cache->{$Year}) and defined($self->_iCal_cache->{$Year}{$Month})){ |
83
|
24
|
|
|
|
|
39
|
@Array = sort keys(%{$self->_iCal_cache->{$Year}{$Month}}); |
|
24
|
|
|
|
|
144
|
|
84
|
|
|
|
|
|
|
} |
85
|
24
|
|
|
|
|
181
|
return(\@Array); |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
# Purpose: Get information for the supplied date (list of times in the day there are events) |
89
|
|
|
|
|
|
|
# Usage: my $TimeRef = $object->get_dateinfo(YEAR,MONTH,DAY); |
90
|
|
|
|
|
|
|
sub get_dateinfo |
91
|
|
|
|
|
|
|
{ |
92
|
6
|
|
|
6
|
0
|
1424
|
my($self, $Year, $Month, $Day) = @_; # TODO: verify that they are set |
93
|
6
|
|
|
|
|
24
|
$self->get($Year); |
94
|
6
|
|
|
|
|
16
|
my @Array; |
95
|
6
|
100
|
33
|
|
|
65
|
if(defined($self->_iCal_cache->{$Year}) and defined($self->_iCal_cache->{$Year}{$Month}) and defined($self->_iCal_cache->{$Year}{$Month}{$Day})) { |
|
|
|
66
|
|
|
|
|
96
|
3
|
|
|
|
|
8
|
@Array = sort keys(%{$self->_iCal_cache->{$Year}{$Month}{$Day}}); |
|
3
|
|
|
|
|
16
|
|
97
|
|
|
|
|
|
|
} |
98
|
6
|
|
|
|
|
32
|
return(\@Array); |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
# Purpose: Return an empty array, unsupported. |
102
|
|
|
|
|
|
|
# Usage: my $UIDRef = $object->get_timeinfo(YEAR,MONTH,DAY,TIME); |
103
|
|
|
|
|
|
|
sub get_timeinfo |
104
|
|
|
|
|
|
|
{ |
105
|
18
|
|
|
18
|
0
|
47
|
my($self, $Year, $Month, $Day,$Time) = @_; |
106
|
|
|
|
|
|
|
|
107
|
18
|
50
|
|
|
|
51
|
return(undef) if not $Time eq 'DAY'; |
108
|
|
|
|
|
|
|
|
109
|
18
|
|
|
|
|
69
|
$self->get($Year); |
110
|
|
|
|
|
|
|
|
111
|
18
|
100
|
33
|
|
|
127
|
if( defined($self->_iCal_cache->{$Year}) and |
|
|
|
66
|
|
|
|
|
112
|
|
|
|
|
|
|
defined($self->_iCal_cache->{$Year}{$Month}) and |
113
|
|
|
|
|
|
|
defined($self->_iCal_cache->{$Year}{$Month}{$Day}) |
114
|
|
|
|
|
|
|
) |
115
|
|
|
|
|
|
|
{ |
116
|
12
|
|
|
|
|
95
|
return($self->_iCal_cache->{$Year}{$Month}{$Day}{$Time}); |
117
|
|
|
|
|
|
|
} |
118
|
6
|
|
|
|
|
30
|
return([]); |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
# Purpose: Get a list of months which have events (those with *only* recurring not counted) |
122
|
|
|
|
|
|
|
# Usage: my $ArrayRef = $object->get_months(YEAR); |
123
|
|
|
|
|
|
|
sub get_months |
124
|
|
|
|
|
|
|
{ |
125
|
6
|
|
|
6
|
0
|
17
|
my ($self, $Year) = @_; |
126
|
6
|
|
|
|
|
30
|
$self->get($Year); |
127
|
6
|
|
|
|
|
11
|
my @Array = sort keys(%{$self->_iCal_cache->{$Year}}); |
|
6
|
|
|
|
|
46
|
|
128
|
6
|
|
|
|
|
40
|
return(\@Array); |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
# Purpose: Check if there is an holiday event with the supplied UID |
132
|
|
|
|
|
|
|
# Usage: $bool = $object->exists($UID); |
133
|
|
|
|
|
|
|
sub exists |
134
|
|
|
|
|
|
|
{ |
135
|
36
|
|
|
36
|
0
|
42910
|
my $self = shift; |
136
|
36
|
|
|
|
|
67
|
my $UID = shift; |
137
|
36
|
100
|
|
|
|
231
|
return(true) if defined($self->_UID_List->{$UID}); |
138
|
3
|
|
|
|
|
13
|
return(false); |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
# -- Unsupported or dummy methods, here for compatibility -- |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
# Purpose: Return an empty array, unsupported. |
144
|
|
|
|
|
|
|
# Usage: my $ArrayRef = $object->get_years(); |
145
|
|
|
|
|
|
|
sub get_years |
146
|
|
|
|
|
|
|
{ |
147
|
3
|
|
|
3
|
0
|
4331
|
return([]); |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
# -- DP::iCalendar compatibility code -- |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
# Used by DP::iCalendar::Manager to set the prodid in output iCalendar files. |
153
|
|
|
|
|
|
|
# We can't output iCalendar files, so we just ignore calls to it. |
154
|
|
|
|
3
|
0
|
|
sub set_prodid { } |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
# Purpose: Return manager information |
157
|
|
|
|
|
|
|
# Usage: get_manager_version(); |
158
|
|
|
|
|
|
|
sub get_manager_version |
159
|
|
|
|
|
|
|
{ |
160
|
6
|
|
|
6
|
0
|
2271
|
my $self = shift; |
161
|
6
|
|
|
|
|
29
|
return('01_capable'); |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
# Purpose: Return manager capability information |
165
|
|
|
|
|
|
|
# Usage: get_manager_capabilities |
166
|
|
|
|
|
|
|
sub get_manager_capabilities |
167
|
|
|
|
|
|
|
{ |
168
|
|
|
|
|
|
|
# All capabilites as of 01_capable |
169
|
6
|
|
|
6
|
0
|
26
|
return(['LIST_DPI',]) |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
# -- Private methods -- |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
# Purpose: Wraps _addParsedEvent in Date::HolidayParser so that an iCalendar version |
176
|
|
|
|
|
|
|
# is also created at the same time. |
177
|
|
|
|
|
|
|
around '_addParsedEvent' => sub |
178
|
|
|
|
|
|
|
{ |
179
|
|
|
|
|
|
|
my $orig = shift; |
180
|
|
|
|
|
|
|
my $self = shift; |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
my($FinalParsing,$final_mon,$final_mday,$HolidayName,$holidayType,$FinalYDay,$PosixYear) = @_; |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
my $UID = $self->_event_to_iCalendar($FinalYDay,$PosixYear,$HolidayName); |
185
|
|
|
|
|
|
|
my $Year = $PosixYear+1900; |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
if(not $self->_iCal_cache->{$Year}->{$final_mon}{$final_mday}{'DAY'}) |
188
|
|
|
|
|
|
|
{ |
189
|
|
|
|
|
|
|
$self->_iCal_cache->{$Year}->{$final_mon}{$final_mday}{'DAY'} = []; |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
push(@{$self->_iCal_cache->{$Year}->{$final_mon}{$final_mday}{'DAY'}}, $UID); |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
return $self->$orig(@_); |
194
|
|
|
|
|
|
|
}; |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
# Purpose: Generate an iCalendar entry |
197
|
|
|
|
|
|
|
# Usage: this->_event_to_iCalendar(UNIXTIME, NAME); |
198
|
|
|
|
|
|
|
sub _event_to_iCalendar |
199
|
|
|
|
|
|
|
{ |
200
|
44
|
|
|
44
|
|
72
|
my $self = shift; |
201
|
44
|
|
|
|
|
65
|
my $FinalYDay = shift; |
202
|
44
|
|
|
|
|
61
|
my $PosixYear = shift; |
203
|
44
|
|
|
|
|
73
|
my $name = shift; |
204
|
44
|
|
|
|
|
184
|
$name =~ s/\s/-/g; |
205
|
|
|
|
|
|
|
|
206
|
44
|
|
|
|
|
435
|
my $unixtime = POSIX::mktime(0, 0, 0, $FinalYDay, 0, $PosixYear); |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
# Generate the UID of the event, this is simply a |
209
|
44
|
|
|
|
|
154
|
my $sum = unpack('%32C*', $name); |
210
|
|
|
|
|
|
|
# This should be unique enough for our needs. |
211
|
|
|
|
|
|
|
# We don't want it to be random, because if someone copies the events to their |
212
|
|
|
|
|
|
|
# own calendar, we want DP::iCalendar::Manager to fetch the information from |
213
|
|
|
|
|
|
|
# the changed calendar, instead of from the HolidayParser object. |
214
|
44
|
|
|
|
|
136
|
my $UID = 'D-HP-ICS-'.$FinalYDay.'-'.$PosixYear.'-'.$sum; |
215
|
|
|
|
|
|
|
|
216
|
44
|
|
|
|
|
93
|
$self->_UID_List->{$UID} = { |
217
|
|
|
|
|
|
|
UID => $UID, |
218
|
|
|
|
|
|
|
DTSTART => iCal_ConvertFromUnixTime($unixtime), |
219
|
|
|
|
|
|
|
DTEND => iCal_ConvertFromUnixTime($unixtime+86390), # Yes, this is purposefully not 86400 |
220
|
|
|
|
|
|
|
SUMMARY => $name, |
221
|
|
|
|
|
|
|
}; |
222
|
44
|
|
|
|
|
126
|
return($UID); |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
# The following three functions are originally from DP::iCalendar |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
# Purpose: Generate an iCalendar date-time from multiple values |
228
|
|
|
|
|
|
|
# Usage: my $iCalDateTime = iCal_GenDateTime(YEAR, MONTH, DAY, TIME); |
229
|
|
|
|
|
|
|
sub iCal_GenDateTime { |
230
|
|
|
|
|
|
|
# NOTE: This version ignores $Time because it isn't used in HolidayParser |
231
|
88
|
|
|
88
|
0
|
179
|
my ($Year, $Month, $Day, $Time) = @_; |
232
|
|
|
|
|
|
|
# Fix the month and day |
233
|
88
|
|
|
|
|
146
|
my $iCalMonth = _PrefixZero($Month); |
234
|
88
|
|
|
|
|
178
|
my $iCalDay = _PrefixZero($Day); |
235
|
88
|
|
|
|
|
427
|
return("$Year$iCalMonth$iCalDay"); |
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
# Purpose: Generate an iCalendar date-time string from a UNIX time string |
239
|
|
|
|
|
|
|
# Usage: my $iCalDateTime = iCal_ConvertFromUnixTime(UNIX TIME); |
240
|
|
|
|
|
|
|
sub iCal_ConvertFromUnixTime { |
241
|
88
|
|
|
88
|
0
|
135
|
my $UnixTime = shift; |
242
|
88
|
|
|
|
|
583
|
my ($realsec,$realmin,$realhour,$realmday,$realmonth,$realyear,$realwday,$realyday,$realisdst) = localtime($UnixTime); |
243
|
88
|
|
|
|
|
203
|
$realyear += 1900; # Fix the year |
244
|
88
|
|
|
|
|
116
|
$realmonth++; # Fix the month |
245
|
|
|
|
|
|
|
# Return data from iCal_GenDateTime |
246
|
88
|
|
|
|
|
231
|
return(iCal_GenDateTime($realyear,$realmonth,$realmday,"$realhour:$realmin")); |
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
# Purpose: Prefix a "0" to a number if it is only one digit. |
250
|
|
|
|
|
|
|
# Usage: my $NewNumber = PrefixZero(NUMBER); |
251
|
|
|
|
|
|
|
sub _PrefixZero { |
252
|
176
|
100
|
|
176
|
|
535
|
if ($_[0] =~ /^\d$/) { |
253
|
88
|
|
|
|
|
217
|
return("0$_[0]"); |
254
|
|
|
|
|
|
|
} |
255
|
88
|
|
|
|
|
158
|
return($_[0]); |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
# End of Date::HolidayParser::iCalendar |
259
|
|
|
|
|
|
|
1; |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
__END__ |