Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | |
2 | =head1 NAME | |
3 | ||
4 | Date::Calendar::Profiles - Some sample profiles for Date::Calendar | |
5 | and Date::Calendar::Year | |
6 | ||
7 | =head1 SYNOPSIS | |
8 | ||
9 | use Date::Calendar::Profiles qw( $Profiles ); | |
10 | use Date::Calendar; | |
11 | ||
12 | $cal_US_AK = Date::Calendar->new( $Profiles->{'US-AK'} [,LANG] ); | |
13 | $cal_DE_BY = Date::Calendar->new( $Profiles->{'DE-BY'} [,LANG] ); | |
14 | ||
15 | or | |
16 | ||
17 | use Date::Calendar::Profiles qw( $Profiles ); | |
18 | use Date::Calendar::Year; | |
19 | ||
20 | $year_2000_US_FL = Date::Calendar::Year->new( 2000, $Profiles->{'US-FL'} [,LANG] ); | |
21 | $year_2001_DE_NW = Date::Calendar::Year->new( 2001, $Profiles->{'DE-NW'} [,LANG] ); | |
22 | ||
23 | and also | |
24 | ||
25 | use Date::Calendar::Profiles | |
26 | qw( | |
27 | &Previous_Friday | |
28 | &Next_Monday | |
29 | &Next_Monday_or_Tuesday | |
30 | &Nearest_Workday | |
31 | &Sunday_to_Monday | |
32 | &Advent1 | |
33 | &Advent2 | |
34 | &Advent3 | |
35 | &Advent4 | |
36 | &Advent | |
37 | ); | |
38 | ||
39 | =head1 PREFACE | |
40 | ||
41 | This module provides some sample profiles (i.e., holiday schemes) | |
42 | for use with the Date::Calendar(3) and Date::Calendar::Year(3) | |
43 | module. | |
44 | ||
45 | You are not required to use these, you can always roll your own | |
46 | (this is very easy). See the section "HOW TO ROLL YOUR OWN" below | |
47 | for more instructions on how to do this, and take the profiles | |
48 | from this module as examples. | |
49 | ||
50 | Please let me know of any errors in these profiles, and please | |
51 | send me your own profiles if you'd like to see them included in | |
52 | the next release of this module! Thank you! | |
53 | ||
54 | (But please, only use the ISO-Latin-1 character set whenever | |
55 | possible, since my module doesn't support any other character | |
56 | sets yet, or at least tell me which character set you used | |
57 | so I can document this in this manual page. Thank you!) | |
58 | ||
59 | =head1 DESCRIPTION | |
60 | ||
61 | The method "init()" in module Date::Calendar::Year(3) is | |
62 | responsible for parsing the calendar schemes contained | |
63 | here in the Date::Calendar::Profiles module. | |
64 | ||
65 | This method offers a "mini-language" which allows to | |
66 | specify common date formulas, like for instance a simple | |
67 | fixed date (in various different formats, e.g. american | |
68 | or european), or things like "the second Sunday of May" | |
69 | (Mother's Day), or "Easter Sunday minus 46 days" (Ash | |
70 | Wednesday), to cite just a few. | |
71 | ||
72 | See the section "DATE FORMULA SYNTAX" below for more | |
73 | details. | |
74 | ||
75 | There are some more complicated formulas, however, which | |
76 | cannot be expressed in such simple terms. | |
77 | ||
78 | The rule that if a holiday falls on a weekend, it will | |
79 | be substituted by either the adjacent Friday or Monday | |
80 | (whichever lies closer), is an example of this. | |
81 | ||
82 | In order to be able to deal with such formulas, and in | |
83 | order to be as flexible as possible, the "init()" method | |
84 | offers the possibility of using callback functions to | |
85 | deal with such dates and formulas. | |
86 | ||
87 | See the section "CALLBACK INTERFACE" below for more | |
88 | details on this topic. | |
89 | ||
90 | In order to assist you with more common cases of odd | |
91 | formulas, the module Date::Calendar::Profiles exports | |
92 | the following utility subroutines (which are meant to | |
93 | be used as "filters" in callback functions of your own): | |
94 | ||
95 | =over 2 | |
96 | ||
97 | =item * | |
98 | ||
99 | C<($year,$month,$day[,ANYTHING]) = Previous_Friday($year,$month,$day[,ANYTHING]);> | |
100 | ||
101 | If the given date falls on a Saturday or Sunday, this | |
102 | function changes the date to the adjacent Friday before | |
103 | that, and returns this new date. | |
104 | ||
105 | Otherwise the given date is returned unchanged. | |
106 | ||
107 | The rest of the input parameters, if any, are simply | |
108 | copied to the output. | |
109 | ||
110 | =item * | |
111 | ||
112 | C<($year,$month,$day[,ANYTHING]) = Next_Monday($year,$month,$day[,ANYTHING]);> | |
113 | ||
114 | If the given date falls on a Saturday or Sunday, this | |
115 | function changes the date to the adjacent Monday after | |
116 | that, and returns this new date. | |
117 | ||
118 | Otherwise the given date is returned unchanged. | |
119 | ||
120 | The rest of the input parameters, if any, are simply | |
121 | copied to the output. | |
122 | ||
123 | =item * | |
124 | ||
125 | C<($year,$month,$day[,ANYTHING]) = Next_Monday_or_Tuesday($year,$month,$day[,ANYTHING]);> | |
126 | ||
127 | If the given date falls on a Saturday, the date of the next | |
128 | Monday (after that weekend) is returned. | |
129 | ||
130 | If the given date falls on a Sunday, the date of the next | |
131 | Tuesday (after that weekend) is returned. | |
132 | ||
133 | If the given date falls on a Monday, the date of the next | |
134 | Tuesday (the day after the Monday) is returned. | |
135 | ||
136 | Otherwise the given date is returned unchanged. | |
137 | ||
138 | The rest of the input parameters, if any, are simply | |
139 | copied to the output. | |
140 | ||
141 | This function is used for the second of two adjacent | |
142 | holidays, where the first holiday obeys the "Next | |
143 | Monday" rule (see the description of the function | |
144 | immediately above). | |
145 | ||
146 | Examples of this are Christmas and Boxing Day, among | |
147 | others. | |
148 | ||
149 | When the first holiday falls on Friday, the second one | |
150 | falls on Saturday and is substituted by Monday. | |
151 | ||
152 | When the first holiday falls on a Saturday, the second | |
153 | one falls on Sunday, so the first holiday is substituted | |
154 | by Monday and the second one by Tuesday. | |
155 | ||
156 | When the first holiday falls on a Sunday, the second | |
157 | one falls on a Monday. Therefore the first holiday is | |
158 | substituted by Monday, and consequently the second | |
159 | holiday must be substituted by Tuesday. | |
160 | ||
161 | Or, in other terms: | |
162 | ||
163 | Fri Sat => Fri Mon | |
164 | Sat Sun => Mon Tue | |
165 | Sun Mon => Mon Tue | |
166 | ||
167 | Note that there is no filter subroutine yet for the | |
168 | second of two adjacent holidays when the first holiday | |
169 | obeys the "Nearest Workday" rule (see the function | |
170 | described immediately below), i.e., | |
171 | ||
172 | Fri Sat => Fri Mon | |
173 | Sat Sun => Fri Mon | |
174 | Sun Mon => Mon Tue | |
175 | ||
176 | This is left as an excercise to the inclined reader. C<:-)> | |
177 | ||
178 | =item * | |
179 | ||
180 | C<($year,$month,$day[,ANYTHING]) = Nearest_Workday($year,$month,$day[,ANYTHING]);> | |
181 | ||
182 | If the given date falls on a Saturday, this function | |
183 | returns the date of the Friday on the day before. | |
184 | ||
185 | If the given date falls on a Sunday, this function | |
186 | returns the date of the Monday on the day after. | |
187 | ||
188 | Otherwise the given date is returned unchanged. | |
189 | ||
190 | The rest of the input parameters, if any, are simply | |
191 | copied to the output. | |
192 | ||
193 | =item * | |
194 | ||
195 | C<($year,$month,$day[,ANYTHING]) = Sunday_to_Monday($year,$month,$day[,ANYTHING]);> | |
196 | ||
197 | If the given date falls on a Sunday, this function | |
198 | returns the date of the Monday on the day after. | |
199 | ||
200 | Otherwise the given date is returned unchanged. | |
201 | ||
202 | The rest of the input parameters, if any, are simply | |
203 | copied to the output. | |
204 | ||
205 | =back | |
206 | ||
207 | The typical use of these filter subroutines is in a "return" | |
208 | statement at the end of callback functions of your own, when | |
209 | you already have calculated the holiday in question and only | |
210 | need to adjust it according to the rule implemented by the | |
211 | filter subroutine in question. | |
212 | ||
213 | See also the implementation of the Date::Calendar::Profiles | |
214 | module for examples of how to use these functions. | |
215 | ||
216 | =head1 DATE FORMULA SYNTAX | |
217 | ||
218 | - Fixed dates: | |
219 | ||
220 | "Christmas" => "24.12", # European format (day, month) | |
221 | "Christmas" => "24.12.", | |
222 | ||
223 | "Christmas" => "24Dec", | |
224 | "Christmas" => "24.Dec", | |
225 | "Christmas" => "24Dec.", | |
226 | "Christmas" => "24.Dec.", | |
227 | ||
228 | "Christmas" => "24-12", | |
229 | "Christmas" => "24-12-", | |
230 | ||
231 | "Christmas" => "24-Dec", | |
232 | "Christmas" => "24-Dec-", | |
233 | ||
234 | "Christmas" => "12/25", # American format (month, day) | |
235 | "Christmas" => "Dec25", | |
236 | "Christmas" => "Dec/25", | |
237 | ||
238 | - Dates relative to Easter Sunday: | |
239 | ||
240 | "Ladies' Carnival" => "-52", | |
241 | "Carnival Monday" => "-48", | |
242 | "Mardi Gras" => "-47", | |
243 | "Ash Wednesday" => "-46", | |
244 | "Palm Sunday" => "-7", | |
245 | "Maundy Thursday" => "-3", | |
246 | "Good Friday" => "-2", | |
247 | "Easter Sunday" => "+0", | |
248 | "Easter Monday" => "+1", | |
249 | "Ascension" => "+39", | |
250 | "Whitsunday" => "+49", | |
251 | "Whitmonday" => "+50", | |
252 | "Corpus Christi" => "+60", | |
253 | ||
254 | - The 1st, 2nd, 3rd, 4th or last day of week: | |
255 | ||
256 | "Thanksgiving" => "4Thu11", | |
257 | "Thanksgiving" => "4/Thu/Nov", | |
258 | "Columbus Day" => "2/Mon/Oct", | |
259 | "Columbus Day" => "2/Mon/10", | |
260 | "Columbus Day" => "2/1/Oct", | |
261 | "Columbus Day" => "2/1/10", | |
262 | "Memorial Day" => "5/Mon/May", # LAST Monday of May | |
263 | ||
264 | - Half holidays, commemorative days: | |
265 | ||
266 | "Christmas" => ":24.12.", # only half a day off | |
267 | "Valentine's Day" => "#Feb/14", # not an official holiday | |
268 | ||
269 | =head1 CALLBACK INTERFACE | |
270 | ||
271 | The interface of the callback functions to use with the | |
272 | "init()" method of the Date::Calendar::Year(3) module is | |
273 | very simple: | |
274 | ||
275 | The callback function receives two arguments when called, | |
276 | first the year number for which the holiday is to be | |
277 | calculated, and second the name (the "label") of the | |
278 | holiday in question (which serves as key in the hash | |
279 | of a holiday scheme). | |
280 | ||
281 | This second parameter allows you to use the same callback | |
282 | function for different holidays, which might be more practical | |
283 | (than separate callback functions) if for instance you have | |
284 | a set of similar holidays to calculate, like for instance | |
285 | the four Sundays before Christmas ("Advent"). | |
286 | ||
287 | The callback function "Advent()" (exported by the | |
288 | Date::Calendar::Profiles module) exemplifies this | |
289 | technique. | |
290 | ||
291 | The callback function is expected to return a list | |
292 | "C<($year,$month,$day)>" with the exact date of the | |
293 | holiday (the year number in the output must of course | |
294 | match the year number passed as parameter). | |
295 | ||
296 | A fatal error occurs if the returned list does not | |
297 | constitute a valid date, in the requested year. | |
298 | ||
299 | Optionally, the callback function may return a fourth | |
300 | value (after the date) containing a string, which may | |
301 | be either "#" or ":". | |
302 | ||
303 | The string "#" signifies that the date in question is | |
304 | a purely commemorative date, i.e., that you don't get | |
305 | a day off from work on that day. | |
306 | ||
307 | The string ":" means that the date in question is a | |
308 | "half" holiday, i.e., a day on which you get half a | |
309 | day off from work. | |
310 | ||
311 | In case the holiday in question was not observed or did | |
312 | not exist in the requested year, the callback function | |
313 | may also return an empty list. This will cause the "init()" | |
314 | method to simply drop this holiday for that year. | |
315 | ||
316 | The module Date::Calendar::Profiles exports the sample | |
317 | callback functions "Advent1()", "Advent2()", "Advent3()", | |
318 | "Advent4()" and "Advent()", which might assist you in | |
319 | rolling your own profiles. | |
320 | ||
321 | =head1 HOW TO ROLL YOUR OWN | |
322 | ||
323 | Every calendar profile (holiday scheme) is a hash. | |
324 | ||
325 | The name of the holiday (like "Christmas", for instance) | |
326 | serves as the key in this hash and must therefore be | |
327 | unique (unless you want to override a default which was | |
328 | set previously, but see below for more on this). | |
329 | ||
330 | The value for each key is either a string, which specifies | |
331 | a simple date formula, or the reference of a callback function. | |
332 | ||
333 | See the section "CALLBACK INTERFACE" above for a description | |
334 | of the interface (in and out) of these callback functions. | |
335 | ||
336 | See the section "DATE FORMULA SYNTAX" above and the description | |
337 | of the "init()" method in L<Date::Calendar::Year(3)> for the | |
338 | exact syntax of date formula strings. | |
339 | ||
340 | B<BEWARE> that if keys are not unique in the source code, | |
341 | later entries will overwrite previous ones! I.e., | |
342 | ||
343 | ... | |
344 | "My special holiday" => "01-11", | |
345 | "My special holiday" => "02-11", | |
346 | ... | |
347 | ||
348 | will B<NOT> set two holidays of the same name, one on November | |
349 | first, the other on November second, but only one, on November | |
350 | second! | |
351 | ||
352 | Therefore, in order to use sets of defaults and to be able | |
353 | to override some of them, you must B<FIRST> include any hash | |
354 | containing the default definitions, and B<THEN> write down | |
355 | your own definitions (see also the Date::Calendar::Profiles | |
356 | module for examples of this!), like this: | |
357 | ||
358 | $defaults = | |
359 | { | |
360 | "Holiday #1" => "01-01", | |
361 | "Holiday #2" => "02-02", | |
362 | "Holiday #3" => "03-03" | |
363 | }; | |
364 | ||
365 | $variant1 = | |
366 | { | |
367 | %$defaults, | |
368 | "Holiday #2" => "09-02", | |
369 | "Holiday #4" => "04-04" | |
370 | }; | |
371 | ||
372 | This is because of the way hashes work in Perl. | |
373 | ||
374 | Now let's suppose that you want to write a profile containing | |
375 | all your relatives' and friends' birthdays or anniversaries. | |
376 | ||
377 | Simply go ahead and list them in your program, in any order | |
378 | you like, as follows (for example): | |
379 | ||
380 | $Birthdays = | |
381 | { | |
382 | "Spouse 1971" => "30.12.", | |
383 | "Wedding Day 1992" => "01.09.", | |
384 | "Valentine's Day" => "14.02.", | |
385 | "Son Richard 1996" => "11.05.", | |
386 | "Daughter Irene 1994" => "17.01.", | |
387 | "Mom 1939" => "19.08.", | |
388 | "Dad 1937" => "23.04.", | |
389 | "Brother Timothy 1969" => "24.04.", | |
390 | "Sister Catherine 1973" => "21.10.", | |
391 | "Cousin Paul 1970" => "16.10.", | |
392 | "Aunt Marjorie 1944" => "09.06.", | |
393 | "Uncle George 1941" => "02.08.", | |
394 | "Friend Alexander 1968" => "12.06.", | |
395 | }; | |
396 | ||
397 | The year numbers after the names are not really necessary, | |
398 | but they allow us to display the person's current age. If | |
399 | this year number is omitted, we simply don't display the age. | |
400 | ||
401 | Now in order to query this birthday database, we can use the | |
402 | following little program: | |
403 | ||
404 | #!perl -w | |
405 | ||
406 | use strict; | |
407 | no strict "vars"; | |
408 | use Date::Calc qw(:all); | |
409 | use Date::Calendar; | |
410 | ||
411 | $Birthdays = | |
412 | { | |
413 | ... # (see above) | |
414 | }; | |
415 | ||
416 | @today = Today(); | |
417 | $calendar = Date::Calendar->new( $Birthdays ); | |
418 | $calendar->year( $today[0] ); | |
419 | ||
420 | foreach $key (@ARGV) | |
421 | { | |
422 | if (@list = $calendar->search( $key )) | |
423 | { | |
424 | foreach $date (@list) | |
425 | { | |
426 | @labels = $calendar->labels( $date ); | |
427 | $dow = shift(@labels); | |
428 | # More than one person might have birthday on the same date: | |
429 | $name = $key; | |
430 | foreach $person (@labels) | |
431 | { | |
432 | if (index(lc($person),lc($key)) >= 0) | |
433 | { | |
434 | $name = $person; | |
435 | last; | |
436 | } | |
437 | } | |
438 | $delta = Delta_Days(@today, $date->date()); | |
439 | $age = ''; | |
440 | if ($name =~ s!\s*(\d+)\s*$!!) | |
441 | { | |
442 | $age = $today[0] - $1; | |
443 | $age-- if ($delta > 0); | |
444 | $age = sprintf(" (%2d years old)", $age); | |
445 | } | |
446 | printf | |
447 | ( | |
448 | "%-20.20s: %+5d days => %3.3s %2d-%3.3s-%4d%s\n", | |
449 | $name, | |
450 | $delta, | |
451 | $dow, | |
452 | $date->day(), | |
453 | Month_to_Text($date->month()), | |
454 | $date->year(), | |
455 | $age | |
456 | ); | |
457 | } | |
458 | } | |
459 | else { print "No entry found in birthday list for '$key'!\n" } | |
460 | } | |
461 | ||
462 | __END__ | |
463 | ||
464 | Let us save this program as, say, "birthday.pl". | |
465 | ||
466 | Then we can query this birthday database by providing search strings | |
467 | on the command line, like this (note that this is a (case-insensitive) | |
468 | substring search, B<NOT> a regular expression match!): | |
469 | ||
470 | > date | |
471 | Wed Oct 3 18:05:45 CEST 2001 | |
472 | ||
473 | > perl birthday.pl wed spo | |
474 | Wedding Day : -32 days => Sat 1-Sep-2001 ( 9 years old) | |
475 | Spouse : +88 days => Sun 30-Dec-2001 (29 years old) | |
476 | ||
477 | > perl birthday.pl son daug | |
478 | Son Richard : -145 days => Fri 11-May-2001 ( 5 years old) | |
479 | Daughter Irene : -259 days => Wed 17-Jan-2001 ( 7 years old) | |
480 | ||
481 | > perl birthday.pl broth sist | |
482 | Brother Timothy : -162 days => Tue 24-Apr-2001 (32 years old) | |
483 | Sister Catherine : +18 days => Sun 21-Oct-2001 (27 years old) | |
484 | ||
485 | > perl birthday.pl mom dad | |
486 | Mom : -45 days => Sun 19-Aug-2001 (62 years old) | |
487 | Dad : -163 days => Mon 23-Apr-2001 (64 years old) | |
488 | ||
489 | > perl birthday.pl uncl aunt | |
490 | Uncle George : -62 days => Thu 2-Aug-2001 (60 years old) | |
491 | Aunt Marjorie : -116 days => Sat 9-Jun-2001 (57 years old) | |
492 | ||
493 | > perl birthday.pl alex | |
494 | Friend Alexander : -113 days => Tue 12-Jun-2001 (33 years old) | |
495 | ||
496 | In order to get the whole list, we can supply a substring which is | |
497 | contained in every name, which happens to be a blank (S<C<" ">>): | |
498 | ||
499 | > perl birthday.pl ' ' | |
500 | Daughter Irene : -259 days => Wed 17-Jan-2001 ( 7 years old) | |
501 | Valentine's Day : -231 days => Wed 14-Feb-2001 | |
502 | Dad : -163 days => Mon 23-Apr-2001 (64 years old) | |
503 | Brother Timothy : -162 days => Tue 24-Apr-2001 (32 years old) | |
504 | Son Richard : -145 days => Fri 11-May-2001 ( 5 years old) | |
505 | Aunt Marjorie : -116 days => Sat 9-Jun-2001 (57 years old) | |
506 | Friend Alexander : -113 days => Tue 12-Jun-2001 (33 years old) | |
507 | Uncle George : -62 days => Thu 2-Aug-2001 (60 years old) | |
508 | Mom : -45 days => Sun 19-Aug-2001 (62 years old) | |
509 | Wedding Day : -32 days => Sat 1-Sep-2001 ( 9 years old) | |
510 | Cousin Paul : +13 days => Tue 16-Oct-2001 (30 years old) | |
511 | Sister Catherine : +18 days => Sun 21-Oct-2001 (27 years old) | |
512 | Spouse : +88 days => Sun 30-Dec-2001 (29 years old) | |
513 | ||
514 | By the way, a similar program is included in the "examples" | |
515 | subdirectory of the Date::Calc distribution, called "anniversaries.pl". | |
516 | ||
517 | See also the file "EXAMPLES.txt" in the distribution's main directory | |
518 | for a short description of that little script. | |
519 | ||
520 | =head1 SEE ALSO | |
521 | ||
522 | Date::Calendar(3), Date::Calendar::Year(3), | |
523 | Date::Calc::Object(3), Date::Calc(3). | |
524 | ||
525 | =head1 VERSION | |
526 | ||
527 | This man page documents "Date::Calendar::Profiles" version 5.3. | |
528 | ||
529 | =head1 AUTHOR | |
530 | ||
531 | Steffen Beyer | |
532 | mailto:sb@engelschall.com | |
533 | http://www.engelschall.com/u/sb/download/ | |
534 | ||
535 | =head1 COPYRIGHT | |
536 | ||
537 | Copyright (c) 2000 - 2002 by Steffen Beyer. All rights reserved. | |
538 | ||
539 | =head1 LICENSE | |
540 | ||
541 | This package is free software; you can redistribute it and/or | |
542 | modify it under the same terms as Perl itself, i.e., under the | |
543 | terms of the "Artistic License" or the "GNU General Public License". | |
544 | ||
545 | Please refer to the files "Artistic.txt" and "GNU_GPL.txt" | |
546 | in this distribution for details! | |
547 | ||
548 | =head1 DISCLAIMER | |
549 | ||
550 | This package is distributed in the hope that it will be useful, | |
551 | but WITHOUT ANY WARRANTY; without even the implied warranty of | |
552 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. | |
553 | ||
554 | See the "GNU General Public License" for more details. | |
555 |