File Coverage

blib/lib/Date/HolidayParser.pm
Criterion Covered Total %
statement 221 297 74.4
branch 111 180 61.6
condition 16 46 34.7
subroutine 15 18 83.3
pod 4 4 100.0
total 367 545 67.3


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