File Coverage

blib/lib/Date/HolidayParser.pm
Criterion Covered Total %
statement 226 297 76.0
branch 111 180 61.6
condition 16 46 34.7
subroutine 15 18 83.3
pod 2 4 50.0
total 370 545 67.8


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             package Date::HolidayParser;
14              
15 3     3   70412 use Moo;
  3         11645  
  3         15  
16 3     3   2140 use Carp;
  3         9  
  3         185  
17 3     3   35 use Exporter;
  3         6  
  3         108  
18 3     3   1612 use POSIX;
  3         20261  
  3         16  
19 3     3   8765 use constant { true => 1, false => 0 };
  3         7  
  3         13415  
20              
21             # Exportable functions are EasterCalc
22             my @EXPORT_OK = qw(EasterCalc);
23              
24             # Deprecated silencing variable
25             our $BeSilent;
26              
27             # Version number
28             our $VERSION;
29             $VERSION = 0.4_2;
30              
31             # --- Attributes ---
32             has 'file' => (
33             is => 'ro',
34             );
35              
36             has 'silent' => (
37             is => 'rw',
38             );
39              
40             has '_cache' => (
41             is => 'rw',
42             default => sub { {} },
43             );
44              
45             has '_parsed' => (
46             is => 'rw',
47             # TODO: Move to arrayref(?)
48             default => sub { {} },
49             );
50              
51             # --- Public methods ---
52              
53             # Purpose: Get the holiday information for YEAR
54             # Usage: my $HashRef = $object->get(YEAR);
55             sub get
56             {
57 56     56 1 1961 my $self = shift;
58 56         86 my $Year = shift;
59 56 50 33     385 if(not defined $Year)
    50          
    50          
60             {
61 0         0 carp('Date::HolidayParser->get needs an parameter: The year to parse');
62 0         0 return;
63             }
64             elsif($Year =~ /\D/)
65             {
66 0         0 carp("Date::HolidayParser: The year must be a digit (was '$Year')");
67 0         0 return;
68             }
69             elsif($Year < 1971 || $Year > 2037)
70             {
71 0         0 carp('Date::HolidayParser: Can\'t parse years lower than 1971 or higher than 2037');
72 0         0 return;
73             }
74 56 100       227 if(not $self->_cache->{$Year})
75             {
76 5         24 $self->_cache->{$Year} = $self->_interperate_year($Year);
77             }
78 56         131 return($self->_cache->{$Year});
79             }
80              
81             # --- Public functions ---
82              
83             # Easter calculation using the gauss algorithm. See:
84             # http://en.wikipedia.org/wiki/Computus#Gauss.27s_algorithm
85             # Parts of the code stolen from Kenny Fowler
86             #
87             # Purpose: Calculate on which day easter occurs on in the year YEAR
88             # Usage: $EasterYDay = EasterCalc(YEAR);
89             #
90             # YEAR must be absolute and not relative to 1900
91             sub EasterCalc {
92 15     15 1 32 my $year = shift;
93              
94 15         83 my $c;
95             my $l;
96 15         0 my $k;
97 15         0 my $d;
98 15         0 my $r;
99 15         0 my $j;
100 15         0 my $NewTime;
101              
102 15         46 $c = int($year/100);
103              
104 15         33 $l = $year % 19;
105              
106 15         28 $k = int(($c - 17)/25);
107              
108 15         47 $d = (15 + $c - int($c/4) - int(($c-$k)/3) + 19*$l) % 30;
109              
110 15         31 $r = $d - int(($d + int($l/11))/29);
111              
112 15         37 $j = ($year + int($year/4) + $r + 2 - $c + int($c/4)) % 7;
113              
114 15         28 my $number = 28 + $r - $j;
115              
116 15 50       44 if ($number > 31)
117             {
118 15         24 $number = $number - 31;
119 15         23 $year = $year - 1900;
120 15         268 $NewTime = POSIX::mktime(0, 0, 0, $number, 3, $year);
121             } else {
122 0         0 $year = $year - 1900;
123 0         0 $NewTime = POSIX::mktime(0, 0, 0, $number, 2, $year);
124             }
125 15         154 my ($easter_sec,$easter_min,$easter_hour,$easter_mday,$easter_mon,$easter_year,$easter_wday,$easter_yday,$easter_isdst) = localtime($NewTime);
126 15         50 return($easter_yday);
127             }
128              
129             # --- Moose construction methods ---
130             sub BUILDARGS
131             {
132 6     6 0 16747 my $class = shift;
133 6         17 my $file = shift;
134 6 50       21 if (defined $file)
135             {
136 6         22 unshift(@_,'file',$file);
137             }
138 6         47 return $class->SUPER::BUILDARGS(@_);
139             }
140              
141             sub BUILD
142             {
143 6     6 0 59 my $self = shift;
144              
145 6 50       214 if(not $self->file)
    50          
146             {
147 0         0 carp('Needs a parameter: Path to the holiday file to load and parse');
148             }
149             elsif(not -e $self->file)
150             {
151 0         0 carp($self->file.': does not exist');
152             }
153 6         60 $self->_load_and_parse($self->file);
154             }
155              
156              
157             # --- Private methods ---
158              
159             # Purpose: Add a parsed event to the final hash
160             # Usage: obj->_addParsedEvent(FinalParsing, final_mon, final_mday, holidayName, HolidayType, finalYDay, PosixYear);
161             # The reason this is used is because submodules, ie. ::iCalendar, overrides or wraps this to generate
162             # data specific to that module.
163             sub _addParsedEvent
164             {
165 55     55   171 my($self,$FinalParsing,$final_mon,$final_mday,$HolidayName,$holidayType,$finalYDay,$PosixYear) = @_;
166 55         234 $FinalParsing->{$final_mon}{$final_mday}{$HolidayName} = $holidayType;
167             }
168              
169             # Purpose: Calculate a NumericYDay
170             # Usage: $CreativeParser{FinalYDay} = _HCalc_NumericYDay($CreativeParser{NumericYDay}, $CreativeParser{AddDays}, $CreativeParser{SubtDays});
171             sub _HCalc_NumericYDay
172             {
173 50     50   162 my ($DAY, $ADD_DAYS, $SUBTRACT_DAYS) = @_;
174 50 100       119 if(defined($ADD_DAYS))
175             {
176 15         28 $DAY += $ADD_DAYS;
177             }
178 50 100       99 if(defined($SUBTRACT_DAYS))
179             {
180 5         13 $DAY -= $SUBTRACT_DAYS;
181             }
182             # mday begins on 1 not 0 - we use mday for all calculations, thus
183             # make the day 1-365 instead of 0-364 here
184 50         83 $DAY++;
185 50         105 return($DAY);
186             }
187              
188             # Purpose: Return the English day name of the year day supplied
189             # Usage: $DayName = _Holiday_DayName(INTEGER_NUMBER, YEAR);
190             sub _Holiday_DayName
191             {
192 95     95   137 my $yDay = shift;
193 95         133 my $year = shift;
194 95         136 $year -= 1900;
195              
196 95         1078 my $PosixTime = POSIX::mktime(0, 0, 0, $yDay, 0, $year);
197 95 50       232 die("*** _Holiday_DayName: For some reason mktime returned undef!. Was running: \"POSIX::mktime(0, 0, 0, $yDay, 0, $year)\".\nYou've probably got a loop that has started looping eternally. This error is fatal") unless(defined($PosixTime));
198 95         373 my %NumToDayHash = (
199             0 => 'sunday',
200             1 => 'monday',
201             2 => 'tuesday',
202             3 => 'wednesday',
203             4 => 'thursday',
204             5 => 'friday',
205             6 => 'saturday',
206             7 => 'sunday',
207             );
208 95         691 my ($DayName_sec,$DayName_min,$DayName_hour,$DayName_mday,$DayName_mon,$DayName_year,$DayName_wday,$DayName_yday,$DayName_isdst) = localtime($PosixTime);
209 95         445 return($NumToDayHash{$DayName_wday});
210             }
211              
212             # Purpose: Return the yday of the supplied unix time
213             # Usage: $YDay = _Get_YDay(UNIX_TIME);
214             sub _Get_YDay
215             {
216 35     35   56 my $Unix_Time = shift;
217 35 50 0     120 warn("_Get_YDay: Invalid usage: must be numeric. Got \"$Unix_Time\"") and return(undef) if $Unix_Time =~ /\D/;
218 35         321 my ($get_sec,$get_min,$get_hour,$get_mday,$get_mon,$get_year,$get_wday,$get_yday,$get_isdst) = localtime($Unix_Time);
219 35         132 return($get_yday);
220             }
221              
222             # Purpose: Print a warning about some error during the holiday parsing
223             # Usage: $self->_HolidayError(LINE_NO, FILENAME, ERROR, ACTION_TAKEN);
224             sub _HolidayError
225             {
226 0     0   0 my $self = shift;
227 0         0 $self->_PrintError('Error',@_);
228             }
229              
230             # Purpose: Print a syntax error in a holiday file
231             # Usage: $self->_SyntaxError(LINE_NO, FILENAME, ERROR, ACTION_TAKEN);
232             sub _SyntaxError
233             {
234 0     0   0 my $self = shift;
235 0         0 $self->_PrintError('Syntax error',@_);
236             }
237              
238             # Purpose. Actually print the error
239             # Usage: $self->_PrintError(TYPE,LINE,FILE,ERROR,ACTION);
240             sub _PrintError
241             {
242 0     0   0 my $self = shift;
243 0 0 0     0 if ($BeSilent and not $self->silent)
    0          
244             {
245 0         0 $self->silent(true);
246 0         0 warn('$Date::HolidayParser::BeSilent is deprecated. Use the silent attribute instead\n');
247             }
248             elsif(not $self->silent)
249             {
250 0         0 my($type,$line,$file,$error,$action) = @_;
251 0         0 warn("*** Holiday parser: $type: $error on line $line in $file. $action");
252             }
253             }
254              
255             # Purpose: Interperate and calculate the holiday file
256             # Usage: $self->_interperate_year(YEAR);
257             sub _interperate_year
258             {
259 5     5   13 my $self = shift;
260 5         11 my $Year = shift;
261 5         11 my $PosixYear = $Year - 1900;
262 5         10 my $FinalParsing = {};
263 5         20 foreach my $LineNo (keys(%{$self->_parsed}))
  5         44  
264             {
265 50         85 my ($FinalYDay, $NumericYDay);
266 50         116 my $CreativeParser = $self->_parsed->{$LineNo};
267 50         110 my $HolidayName = $self->_parsed->{$LineNo}{name};
268 50         104 my $File = $self->file;
269 50         287 my %MonthMapping = (
270             'january' => 0,
271             'february' => 1,
272             'march' => 2,
273             'april' => 3,
274             'may' => 4,
275             'june' => 5,
276             'july' => 6,
277             'august' => 7,
278             'september' => 8,
279             'october' => 9,
280             'november' => 10,
281             'december' => 11,
282             ); # Hash mapping the month name to a numeric
283              
284 50 100       136 if(defined($CreativeParser->{AddEaster}))
285             {
286 15         74 $NumericYDay = EasterCalc($Year);
287             }
288 50 100       111 if(defined($CreativeParser->{MonthDay}))
289             {
290 10         34 my $month = $CreativeParser->{MonthDay};
291 10         23 my $day = $CreativeParser->{MonthDay};
292 10         71 $month =~ s/^(\d+)-(\d+)$/$1/;
293 10         68 $day =~ s/^(\d+)-(\d+)$/$2/;
294 10         214 my $PosixTime = POSIX::mktime(0, 0, 0, $day, $month, $PosixYear);
295 10         35 $NumericYDay = _Get_YDay($PosixTime);
296             }
297              
298 50 50 66     173 unless(defined($CreativeParser->{IsMonth}) or defined($NumericYDay))
299             {
300 0         0 $self->_SyntaxError($LineNo, $File, 'I had no day-of-the-year nor a month defined after parsing', 'Ignoring this line');
301 0         0 next;
302             }
303              
304 50 100       163 if(defined($CreativeParser->{MustBeDay}))
    100          
    50          
305             {
306              
307             # If IsMonth is defined then find a NumericYDay that we can use so that
308             # the NumericYDay parsing below can do all of the heavy lifting
309 20 100 66     154 if (defined($CreativeParser->{IsMonth}) and defined($CreativeParser->{Number}))
    50 33        
    0          
310             {
311 15         241 my $PosixTime = POSIX::mktime(0, 0, 0, 1, $MonthMapping{$CreativeParser->{IsMonth}}, $PosixYear);
312 15         56 my $proper_yday = _Get_YDay($PosixTime);
313 15 50       43 unless(defined($CreativeParser->{Number}))
314             {
315 0         0 $self->_HolidayError($LineNo, $File, '$CreativeParser->{Number} is undef', 'Skipping this line. This is probably a bug in the parser');
316 0         0 next;
317             }
318 15 100       46 if($CreativeParser->{Number} eq 'last')
319             {
320             # Find the first of the set day
321 5         11 while(1)
322             {
323 15 100       35 if(_Holiday_DayName($proper_yday, $Year) eq $CreativeParser->{MustBeDay})
324             {
325 5         12 last;
326             }
327 10         18 $proper_yday++;
328             }
329              
330             # Find the last of the set day
331 5         11 my $Last_YDay = $proper_yday;
332 5         8 while(1)
333             {
334 25 50       44 if(_Holiday_DayName($proper_yday, $Year) eq $CreativeParser->{MustBeDay})
335             {
336 25         41 $proper_yday += 7;
337             }
338 25         275 my $MKTime = POSIX::mktime(0, 0, 0, $proper_yday, 0, $PosixYear);
339 25         192 my ($detect_sec,$detect_min,$detect_hour,$detect_mday,$detect_mon,$detect_year,$detect_wday,$detect_yday,$detect_isdst) = localtime($MKTime);
340             # If $detect_mon is not equal to $MonthMapping{$CreativeParser->{IsMonth}} then
341             # we're now on the next month and have found the last of the day
342 25 100       96 unless($detect_mon eq $MonthMapping{$CreativeParser->{IsMonth}})
343             {
344 5         11 last;
345             }
346 20         36 $Last_YDay = $proper_yday;
347             }
348 5         9 $NumericYDay = $Last_YDay;
349 5         13 $CreativeParser->{BeforeOrAfter} = 'before';
350             }
351             else
352             {
353             # Parse the final
354 10         21 $NumericYDay = $proper_yday;
355 10 100       39 if($CreativeParser->{Number} eq 'first')
    50          
    0          
    0          
356             {
357 5         16 $CreativeParser->{BeforeOrAfter} = 'after';
358             }
359             elsif($CreativeParser->{Number} eq 'second')
360             {
361 5         13 $CreativeParser->{BeforeOrAfter} = 'after';
362 5         16 $CreativeParser->{AddDays} = 7;
363             }
364             elsif($CreativeParser->{Number} eq 'third')
365             {
366 0         0 $CreativeParser->{BeforeOrAfter} = 'after';
367 0         0 $CreativeParser->{AddDays} = 14;
368             }
369             elsif($CreativeParser->{Number} eq 'fourth')
370             {
371 0         0 $CreativeParser->{BeforeOrAfter} = 'after';
372 0         0 $CreativeParser->{AddDays} = 21;
373             }
374             else
375             {
376 0 0 0     0 $self->_HolidayError($LineNo, $File, "\$CreativeParer->{Number} is \"$CreativeParser->{Number}\"", 'This is a bug in the parser. This line will be ignored') and next unless $CreativeParser->{Number} eq 'null';
377             }
378             }
379             }
380             elsif (defined($CreativeParser->{IsMonth}) and defined($CreativeParser->{DateNumeric}))
381             {
382 5         86 my $PosixTime = POSIX::mktime(0, 0, 0, $CreativeParser->{DateNumeric}, $MonthMapping{$CreativeParser->{IsMonth}}, $PosixYear);
383 5         17 $NumericYDay = _Get_YDay($PosixTime);
384             }
385             elsif (defined($CreativeParser->{IsMonth}))
386             {
387 0         0 $self->_SyntaxError($LineNo, $File, 'There is a month defined but no way to find out which day of the month it is referring to', 'Ignoring this line.');
388 0         0 next;
389             }
390              
391              
392 20 50       44 if(defined($NumericYDay))
393             {
394             # Parse the main NumericYDay
395 20         98 $FinalYDay = _HCalc_NumericYDay($NumericYDay, $CreativeParser->{AddDays}, $CreativeParser->{SubtDays});
396 20 50       66 unless(defined($CreativeParser->{BeforeOrAfter}))
397             {
398 0         0 $self->_SyntaxError($LineNo, $File, 'It was not defined if the day should be before or after', 'Defaulting to before. This is likely to cause calculation mistakes.');
399 0         0 $CreativeParser->{BeforeOrAfter} = 'before';
400             }
401 20 100       60 if($CreativeParser->{BeforeOrAfter} eq 'before')
    50          
402             {
403             # Before parsing
404             # Okay, we need to find the closest $CreativeParser{MustBeDay} before $CreativeParser{FinalYDay}
405 10         14 while (1)
406             {
407 15 100       32 if(_Holiday_DayName($FinalYDay, $Year) eq $CreativeParser->{MustBeDay})
408             {
409 10         21 last;
410             }
411 5         16 $FinalYDay = $FinalYDay - 1;
412             }
413             }
414             elsif ($CreativeParser->{BeforeOrAfter} eq 'after')
415             {
416             # After parsing
417             # Okay, we need to find the closest $CreativeParser{MustBeDay} after $CreativeParser{FinalYDay}
418 10         16 while (1)
419             {
420 40 100       76 if(_Holiday_DayName($FinalYDay, $Year) eq $CreativeParser->{MustBeDay})
421             {
422 10         22 last;
423             }
424 30         53 $FinalYDay = $FinalYDay + 1;
425             }
426             }
427             else
428             {
429 0         0 $self->_HolidayError($LineNo, $File, "BeforeOrAfter was set to an invalid value ($CreativeParser->{BeforeOrAfter})", 'This is a bug in the parser. This line will be ignored.');
430 0         0 return(undef);
431             }
432             }
433             else
434             {
435 0         0 $self->_SyntaxError($LineNo, $File, 'A day is defined but no other way to find out when the day is could be found', 'Ignoring this line');
436 0         0 next;
437             }
438             }
439             # Calculate the yday of that day-of-the-month
440             elsif(defined($CreativeParser->{IsMonth}))
441             {
442 5 50       15 unless(defined($CreativeParser->{DateNumeric}))
443             {
444 0         0 $self->_SyntaxError($LineNo, $File, 'It was set which month the day should be on but no information about the day itself ', 'Ignoring this line');
445 0         0 next;
446             }
447 5         131 my $PosixTime = POSIX::mktime(0, 0, 0, $CreativeParser->{DateNumeric}, $MonthMapping{$CreativeParser->{IsMonth}}, $PosixYear);
448 5         19 my $proper_yday = _Get_YDay($PosixTime);
449 5         26 $FinalYDay = _HCalc_NumericYDay($proper_yday, $CreativeParser->{AddDays}, $CreativeParser->{SubtDays});
450             }
451             # NumericYDay-only parsing is the simplest solution. This is pure and simple maths
452             elsif(defined($NumericYDay))
453             {
454             # NumericYDay-only parsing is the simplest solution. This is pure and simple maths
455 25 50       54 if(defined($CreativeParser->{MustBeDay}))
456             {
457 0         0 $self->_SyntaxError($LineNo, $File, "It was set exactly which day the holiday should occur on and also that it should occur on $CreativeParser->{MustBeDay}", 'Ignoring the day requirement');
458              
459             }
460 25         94 $FinalYDay = _HCalc_NumericYDay($NumericYDay, $CreativeParser->{AddDays}, $CreativeParser->{SubtDays});
461             }
462              
463             # Verify the use of the "every" keyword
464 50 50 66     165 if(defined($CreativeParser->{Every}) and not defined($CreativeParser->{Number}))
465             {
466 0         0 $self->_SyntaxError($LineNo, $File, 'Use of the "every" keyword without any trailing month', 'Ignoring the "every" keyword.');
467             }
468 50 50 66     141 if(defined($CreativeParser->{Every}) and defined($CreativeParser->{Length}))
469             {
470 0         0 $self->_SyntaxError($LineNo, $File, 'Use of both "every" and "length"', 'This might give unpredictable results.');
471             }
472             # Do the final parsing and add it to the hash
473 50 50 33     359 if(defined($FinalYDay) and $FinalYDay =~ /^\d+$/)
    0          
474             {
475 50         83 while(1)
476             {
477 55 50       101 if(defined($FinalYDay))
478             {
479 55         1054 my ($final_sec,$final_min,$final_hour,$final_mday,$final_mon,$final_year,$final_wday,$final_yday,$final_isdst) = localtime(POSIX::mktime(0, 0, 0, $FinalYDay, 0, $PosixYear));
480 55         120 $final_mon++;
481 55         1120 $self->_addParsedEvent($FinalParsing, $final_mon, $final_mday, $HolidayName, $CreativeParser->{HolidayType}, $FinalYDay, $PosixYear);
482             }
483 55 100 66     228 if(defined($CreativeParser->{Every}) and defined($CreativeParser->{Number}))
    50 33        
484             {
485 5         11 delete($CreativeParser->{Every});
486 5 50       37 if($CreativeParser->{Number} ne 'second')
487             {
488 0         0 $self->_SyntaxError($LineNo, $File, "Nonsense use of $CreativeParser->{Number} along with \"every\"",'Ignoring the "every" keyword.');
489             }
490             else
491             {
492             # Add 14 days
493 5         15 $FinalYDay += 14;
494             }
495             }
496             elsif(defined($CreativeParser->{Length}) and $CreativeParser->{Length} > 0)
497             {
498 0 0       0 $CreativeParser->{Length}-- or die('FATAL: attempted to reduce (--) length but it failed! This is a bug.');
499 0         0 $FinalYDay++;
500             }
501             else
502             {
503 50         207 last;
504             }
505             }
506             }
507             elsif(defined($FinalYDay))
508             {
509 0         0 $self->_HolidayError($LineNo, $File, "Invalid FinalYDay ($FinalYDay) after finished parsing", 'This is a bug in the parser!');
510             }
511             else
512             {
513 0         0 $self->_HolidayError($LineNo, $File, 'No FinalYDay after finished parsing', 'This is a bug in the parser!');
514             }
515             }
516 5         36 return($FinalParsing);
517             }
518              
519             # Purpose: Load and parse the holiday file
520             # Usage: $self->_load_and_parse(FILE);
521             sub _load_and_parse
522             {
523 6     6   15 my $self = shift;
524 6         12 my $File = shift;
525              
526 6 50 0     86 carp("$File does not exist") and return(undef) unless -e $File;
527 6 50 0     111 carp("$File is not readable") and return(undef) unless -r $File;
528              
529 6 50       261 open(my $HolidayFile, '<' ,$File) or croak("Unable to open $File for reading");
530 6         23 my $LineNo;
531 6         201 while(my $Line = <$HolidayFile>)
532             {
533 132         301 $LineNo++;
534 132 100       477 next if $Line =~ /^\s*[:;#]/;# Ignore these lines
535 60 50       160 next if $Line =~ /^\s*$/;# Ignore lines with only whitespace
536 60         179 my $OrigLine = $Line;
537 60         110 my $HolidayType; # red or none (see above)
538              
539             my $LineMode; # Is either PreDec or PostDec
540             # PreDec means that the holiday "mode" is declared before the name of
541             # the holiday.
542             #
543             # PostDec means that the holiday "mode" is declared after the name
544             # of the holiday.
545             #
546             # Note that PreDec incorporated the functions of PostDec aswell, but
547             # not the other way around
548 60 100       178 if($Line =~ /^\s*\"/)
549             {
550 42         83 $LineMode = 'PostDec';
551             }
552             else
553             {
554 18         38 $LineMode = 'PreDec';
555             }
556              
557             # Parse PreDec
558 60 100       130 if($LineMode eq 'PreDec')
559             {
560 18         55 while(not $Line =~ /^\"/)
561             {
562 18         30 my $PreDec = $Line;
563 18         91 $PreDec =~ s/^\s*(\w+)\s+.*$/$1/;
564 18         38 chomp($PreDec);
565 18         431 $Line =~ s/^\s*$PreDec\s+//;
566 18 50       65 unless(length($PreDec))
567             {
568 0         0 $self->_HolidayError($LineNo, $File, "LineMode=PreDec, but the predec parser recieved \"$PreDec\" as PreDec", 'Ignoring this predec');
569 0         0 last;
570             }
571             else
572             {
573 18 50       68 if($PreDec =~ /^(weekend|red)$/)
    0          
574             {
575 18         69 $HolidayType = 'red';
576             }
577             elsif ($PreDec =~ /^(black|small|blue|green|cyan|magenta|yellow)$/)
578             {
579             # These are often just "formatting" declerations, and thus ignored by the day planner
580             # parser. In these cases PostDec usually declares more valid stuff
581 0         0 $HolidayType = 'none';
582 0         0 $Line =~ s/^[^"]+//;
583 0         0 last;
584             }
585             else
586             {
587 0         0 $HolidayType = 'none';
588 0         0 $self->_SyntaxError($LineNo, $File, "Unrecognized holiday type: \"$PreDec\".", 'Defaulting to "none"');
589 0         0 $Line =~ s/^[^"]+//;
590 0         0 last;
591             }
592             }
593             }
594             }
595              
596             # Get the holiday name
597 60         92 my $HolidayName = $Line;
598 60         114 chomp($HolidayName);
599 60         633 $HolidayName =~ s/^\s*\"(.*)\".*$/$1/;
600 60         228 $Line =~ s/^\s*\".*\"//;
601 60 50       233 if ($HolidayName =~ /^\"*$/)
602             {
603 0         0 $self->_SyntaxError($LineNo, $File, 'The name of the holiday was not defined', 'Ignoring this line.');
604 0         0 next;
605             }
606              
607 60 100       175 if ($Line =~ /^\s*(weekend|red|black|small|blue|green|cyan|magenta|yellow)/)
608             {
609 6         16 my $HolidayDec = $Line;
610 6         27 $HolidayDec =~ s/^\s*(\w+)\s+.*$/$1/;
611 6         17 chomp($HolidayDec);
612 6         92 $Line =~ s/^\s*$HolidayDec\s+//;
613              
614 6 50       57 if($HolidayDec =~ /^(weekend|red)$/)
    0          
615             {
616 6         31 $HolidayType = 'red';
617             }
618             elsif ($HolidayDec =~ /^(black|small|blue|green|cyan|magenta|yellow)$/)
619             {
620             # These are just "formatting" keywords, so we ignore them here.
621 0 0 0     0 unless(defined($HolidayType) and $HolidayType eq 'red')
622             {
623 0         0 $HolidayType = 'none';
624             }
625             }
626             else
627             {
628 0         0 $HolidayType = 'none';
629 0         0 $self->_SyntaxError($LineNo, $File, "Unrecognized holiday type: \"$HolidayDec\".", 'Defaulting to "none"');
630             }
631             }
632 60 50       205 unless($Line =~ /^\s*on/)
633             {
634 0         0 $self->_SyntaxError($LineNo, $File, 'Missing "on" keyword', 'Pretending it\'s there. This might give weird effects');
635             }
636             else
637             {
638 60         113 $Line =~ s/^\s*on\*//;
639             }
640              
641             # ==================================================================
642             # Parse main keywords
643             # ==================================================================
644              
645             # This is the hardest part of the parser, now we get creative. We read each word
646             # and run it through the parser
647 60         81 my %CreativeParser;
648 60         305 foreach (split(/\s+/, $Line))
649             {
650 312 100       748 next if /^\s*$/;
651 258 100       1441 if(/^(last|first|second|third|fourth)$/) # This is a number defining when a day should occur, usually used along with
    100          
    100          
    100          
    100          
    100          
    50          
    100          
    50          
    100          
    100          
    100          
    50          
652             {
653             # MustBeDay (below)
654 18         55 $CreativeParser{Number} = $_;
655 18         50 next;
656             }
657             elsif (/^(monday|tuesday|wednesday|thursday|friday|saturday|sunday)$/) # This defines which day the holiday should occur on
658             {
659 24         53 $CreativeParser{MustBeDay} = $_;
660             }
661             elsif (m#^\d+[/\.]\d+\.?$#)
662             { # This regexp gets numbers in the format XX/YY X/Y, XX.YY and X.Y
663             # With an optional trailing .
664 12         34 s/\.$//;
665 12         36 my $day = $_;
666 12         22 my $month = $_;
667 12 100       62 if(m#^\d+\.\d+$#)
    50          
668             { # XX.YY and X.Y is in the format day.month
669 6         40 $day =~ s/(\d+).*/$1/;
670 6         35 $month =~ s#^\d+\.(\d+)\.?$#$1#;
671             }
672             elsif (m#^\d+/\d+$#)
673             { # XX/YY and X/Y is in the format month/day
674 6         28 $month =~ s/(\d+).*/$1/;
675 6         26 $day =~ s#^\d+/(\d+)\.?$#$1#;
676             }
677 12         34 $month--; # The month in the holiday file is 1-12, we use 0-11
678 12         53 $CreativeParser{MonthDay} = "$month-$day";
679             }
680             elsif (/^(january|february|march|april|may|june|july|august|september|october|november|december)$/)
681             { # Which month it occurs in
682 30         66 $CreativeParser{IsMonth} = $_;
683             }
684             elsif (/^plus$/)
685             { # If the next number should be added to a NumericYDay value
686 12         31 $CreativeParser{NextIs} = 'add';
687             }
688             elsif (/^minus$/)
689             { # If the next number should be subtracted to a NumericYDay value
690 6         15 $CreativeParser{NextIs} = 'sub';
691             }
692             elsif (/^length$/)
693             { # How long (in days) it lasts. FIXME: is currently ignored
694 0         0 $CreativeParser{NextIs} = 'length';
695             }
696             elsif (/^easter$/)
697             { # The day of easter
698 18         53 $CreativeParser{AddEaster} = 1;
699             }
700             elsif (/^weekend$/)
701             { # Malplaced weekend keyword
702 0         0 $HolidayType = 'red';
703             }
704             elsif (/^\d+$/)
705             { # Any other number, see below for parsing
706 30 50 0     89 $self->_SyntaxError($LineNo, $File, 'Unreasonably high number', 'Ignoring the number. This might give weird results') and next if $_ > 365;
707             # If NextIs is not defined then it's a DateNumeric
708 30 100 66     141 unless(defined($CreativeParser{NextIs}) and $CreativeParser{NextIs})
709             {
710 12         31 $CreativeParser{DateNumeric} = $_;
711 12         19 next;
712             }
713              
714             # Add to
715 18 100       72 if($CreativeParser{NextIs} eq 'add')
    50          
    0          
716             {
717 12 50       39 if(defined($CreativeParser{AddDays}))
718             {
719 0         0 $CreativeParser{AddDays} = $CreativeParser{AddDays} + $_;
720             }
721             else
722             {
723 12         39 $CreativeParser{AddDays} = $_;
724             }
725             # Subtract from
726             }
727             elsif ($CreativeParser{NextIs} eq 'sub')
728             {
729 6 50       30 if(defined($CreativeParser{SubtDays}))
730             {
731 0         0 $CreativeParser{SubtDays} = $CreativeParser{SubtDays} + $_;
732             }
733             else
734             {
735 6         17 $CreativeParser{SubtDays} = $_;
736             }
737             # How long should it last?
738             }
739             elsif ($CreativeParser{NextIs} eq 'length')
740             {
741 0 0       0 if(defined($CreativeParser{Length}))
742             {
743 0         0 $self->_SyntaxError($LineNo, $File, 'Multiple length statements', "Ignoring \"$_\"");
744             }
745             else
746             {
747 0         0 $CreativeParser{Length} = $_;
748             }
749             }
750              
751             }
752             elsif (/^(before|after)$/)
753             { # If a day should be before or after a certain day/date
754 6         16 $CreativeParser{BeforeOrAfter} = $_;
755             }
756             elsif (/^every$/)
757             {
758 6         19 $CreativeParser{Every} = 1;
759             }
760             elsif (/^(in|on|days|day)$/)
761             { # Ignored, just keywords for easier human parsing
762 96         164 next;
763             }
764             else
765             {
766 0         0 $self->_SyntaxError($LineNo, $File, "Unrecognized keyword \"$_\"", 'Ignoring it. This might cause calculation mistakes! Consider using a combination of other keywords or report this as a bug to the author of this parser if you\'re certain the keyword should be supported');
767             }
768             }
769              
770             # ==================================================================
771             # Finalize the interpretation and add it to $self
772             # ==================================================================
773              
774 60         134 $CreativeParser{HolidayType} = $HolidayType;
775 60         110 $CreativeParser{name} = $HolidayName;
776 60         470 $self->_parsed->{$LineNo} = \%CreativeParser;
777             }
778 6         124 close($HolidayFile);
779             }
780              
781              
782             # End of Date::HolidayParser
783             1;
784              
785             __END__