File Coverage

blib/lib/Date/HolidayParser/iCalendar.pm
Criterion Covered Total %
statement 74 75 98.6
branch 17 20 85.0
condition 7 15 46.6
subroutine 18 18 100.0
pod 2 13 15.3
total 118 141 83.6


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__