| 1 | |
| 2 | ############################################################################### |
| 3 | ## ## |
| 4 | ## Copyright (c) 2000 - 2002 by Steffen Beyer. ## |
| 5 | ## All rights reserved. ## |
| 6 | ## ## |
| 7 | ## This package is free software; you can redistribute it ## |
| 8 | ## and/or modify it under the same terms as Perl itself. ## |
| 9 | ## ## |
| 10 | ############################################################################### |
| 11 | |
| 12 | package Date::Calendar::Profiles; |
| 13 | |
| 14 | use strict; |
| 15 | use vars qw( @ISA @EXPORT @EXPORT_OK $VERSION $Profiles ); |
| 16 | |
| 17 | require Exporter; |
| 18 | |
| 19 | @ISA = qw(Exporter); |
| 20 | |
| 21 | @EXPORT = qw(); |
| 22 | |
| 23 | @EXPORT_OK = qw( |
| 24 | $Profiles |
| 25 | &Previous_Friday |
| 26 | &Next_Monday |
| 27 | &Next_Monday_or_Tuesday |
| 28 | &Nearest_Workday |
| 29 | &Sunday_to_Monday |
| 30 | &Advent1 |
| 31 | &Advent2 |
| 32 | &Advent3 |
| 33 | &Advent4 |
| 34 | &Advent |
| 35 | ); |
| 36 | |
| 37 | $VERSION = '5.3'; |
| 38 | |
| 39 | use Date::Calc qw(:all); |
| 40 | use Carp::Clan qw(^Date::); |
| 41 | |
| 42 | ########################################################################## |
| 43 | # # |
| 44 | # Moving ("variable") holidays depending on the date of Easter Sunday: # |
| 45 | # # |
| 46 | # Weiberfastnacht, Fettdonnerstag = -52 days # |
| 47 | # Carnival Monday / Rosenmontag / Veille du Mardi Gras = -48 days # |
| 48 | # Mardi Gras / Karnevalsdienstag / Mardi Gras = -47 days # |
| 49 | # Ash Wednesday / Aschermittwoch / Mercredi des Cendres = -46 days # |
| 50 | # Palm Sunday / Palmsonntag / Dimanche des Rameaux = -7 days # |
| 51 | # Maundy Thursday / Gruendonnerstag / Jeudi avant Paques = -3 days # |
| 52 | # Good Friday / Karfreitag / Vendredi Saint = -2 days # |
| 53 | # Easter Saturday / Ostersamstag / Samedi de Paques = -1 day # |
| 54 | # Easter Sunday / Ostersonntag / Dimanche de Paques = +0 days # |
| 55 | # Easter Monday / Ostermontag / Lundi de Paques = +1 day # |
| 56 | # Prayer Day / Bettag / Jour de la Priere (Denmark) = +26 days # |
| 57 | # Ascension of Christ / Christi Himmelfahrt / Ascension = +39 days # |
| 58 | # Whitsunday / Pfingstsonntag / Dimanche de Pentecote = +49 days # |
| 59 | # Whitmonday / Pfingstmontag / Lundi de Pentecote = +50 days # |
| 60 | # Feast of Corpus Christi / Fronleichnam / Fete-Dieu = +60 days # |
| 61 | # # |
| 62 | ########################################################################## |
| 63 | |
| 64 | ############################################### |
| 65 | # # |
| 66 | # Rules to enhance readability: # |
| 67 | # # |
| 68 | # 1) First level constants in single quotes, # |
| 69 | # second level constants in double quotes. # |
| 70 | # 2) Use leading zeros for fixed length. # |
| 71 | # # |
| 72 | ############################################### |
| 73 | |
| 74 | ##################### |
| 75 | # Global variables: # |
| 76 | ##################### |
| 77 | |
| 78 | $Profiles = { }; |
| 79 | |
| 80 | ############################### |
| 81 | # Global utility subroutines: # |
| 82 | ############################### |
| 83 | |
| 84 | sub Previous_Friday |
| 85 | { |
| 86 | my($yy) = shift; |
| 87 | my($mm) = shift; |
| 88 | my($dd) = shift; |
| 89 | my($dow); |
| 90 | |
| 91 | # If holiday falls on Saturday or Sunday, use previous Friday instead: |
| 92 | |
| 93 | $dow = Day_of_Week($yy,$mm,$dd); |
| 94 | if ($dow == 6) { ($yy,$mm,$dd) = Add_Delta_Days($yy,$mm,$dd,-1); } |
| 95 | elsif ($dow == 7) { ($yy,$mm,$dd) = Add_Delta_Days($yy,$mm,$dd,-2); } |
| 96 | return($yy,$mm,$dd,@_); |
| 97 | } |
| 98 | |
| 99 | sub Next_Monday |
| 100 | { |
| 101 | my($yy) = shift; |
| 102 | my($mm) = shift; |
| 103 | my($dd) = shift; |
| 104 | my($dow); |
| 105 | |
| 106 | # If holiday falls on Saturday, use following Monday instead; |
| 107 | # if holiday falls on Sunday, use day thereafter (Monday) instead: |
| 108 | |
| 109 | $dow = Day_of_Week($yy,$mm,$dd); |
| 110 | if ($dow == 6) { ($yy,$mm,$dd) = Add_Delta_Days($yy,$mm,$dd,+2); } |
| 111 | elsif ($dow == 7) { ($yy,$mm,$dd) = Add_Delta_Days($yy,$mm,$dd,+1); } |
| 112 | return($yy,$mm,$dd,@_); |
| 113 | } |
| 114 | |
| 115 | sub Next_Monday_or_Tuesday # For second holiday of two adjacent ones! |
| 116 | { |
| 117 | my($yy) = shift; |
| 118 | my($mm) = shift; |
| 119 | my($dd) = shift; |
| 120 | my($dow); |
| 121 | |
| 122 | # If holiday falls on Saturday, use following Monday instead; |
| 123 | # if holiday falls on Sunday or Monday, use next Tuesday instead |
| 124 | # (because Monday is already taken by adjacent holiday on the day before): |
| 125 | |
| 126 | $dow = Day_of_Week($yy,$mm,$dd); |
| 127 | if ($dow == 6 or $dow == 7) { ($yy,$mm,$dd) = Add_Delta_Days($yy,$mm,$dd,+2); } |
| 128 | elsif ($dow == 1) { ($yy,$mm,$dd) = Add_Delta_Days($yy,$mm,$dd,+1); } |
| 129 | return($yy,$mm,$dd,@_); |
| 130 | } |
| 131 | |
| 132 | sub Nearest_Workday |
| 133 | { |
| 134 | my($yy) = shift; |
| 135 | my($mm) = shift; |
| 136 | my($dd) = shift; |
| 137 | my($dow); |
| 138 | |
| 139 | # If holiday falls on Saturday, use day before (Friday) instead; |
| 140 | # if holiday falls on Sunday, use day thereafter (Monday) instead: |
| 141 | |
| 142 | $dow = Day_of_Week($yy,$mm,$dd); |
| 143 | if ($dow == 6) { ($yy,$mm,$dd) = Add_Delta_Days($yy,$mm,$dd,-1); } |
| 144 | elsif ($dow == 7) { ($yy,$mm,$dd) = Add_Delta_Days($yy,$mm,$dd,+1); } |
| 145 | return($yy,$mm,$dd,@_); |
| 146 | } |
| 147 | |
| 148 | sub Sunday_to_Monday |
| 149 | { |
| 150 | my($yy) = shift; |
| 151 | my($mm) = shift; |
| 152 | my($dd) = shift; |
| 153 | my($dow); |
| 154 | |
| 155 | # If holiday falls on Sunday, use day thereafter (Monday) instead: |
| 156 | |
| 157 | $dow = Day_of_Week($yy,$mm,$dd); |
| 158 | if ($dow == 7) { ($yy,$mm,$dd) = Add_Delta_Days($yy,$mm,$dd,+1); } |
| 159 | return($yy,$mm,$dd,@_); |
| 160 | } |
| 161 | |
| 162 | ###################################### |
| 163 | # Global utility callback functions: # |
| 164 | ###################################### |
| 165 | |
| 166 | sub Advent1 |
| 167 | { |
| 168 | my($year,$label) = @_; |
| 169 | return( Add_Delta_Days($year,12,25, |
| 170 | -(Day_of_Week($year,12,25)+21)), '#' ); |
| 171 | } |
| 172 | sub Advent2 |
| 173 | { |
| 174 | my($year,$label) = @_; |
| 175 | return( Add_Delta_Days($year,12,25, |
| 176 | -(Day_of_Week($year,12,25)+14)), '#' ); |
| 177 | } |
| 178 | sub Advent3 |
| 179 | { |
| 180 | my($year,$label) = @_; |
| 181 | return( Add_Delta_Days($year,12,25, |
| 182 | -(Day_of_Week($year,12,25)+7)), '#' ); |
| 183 | } |
| 184 | sub Advent4 |
| 185 | { |
| 186 | my($year,$label) = @_; |
| 187 | return( Add_Delta_Days($year,12,25, |
| 188 | -Day_of_Week($year,12,25)), '#' ); |
| 189 | } |
| 190 | |
| 191 | sub Advent |
| 192 | { |
| 193 | my($year,$label) = @_; |
| 194 | my($offset); |
| 195 | |
| 196 | $offset = (4 - substr($label,0,1)) * 7; |
| 197 | return( Add_Delta_Days($year,12,25, |
| 198 | -(Day_of_Week($year,12,25)+$offset)), '#' ); |
| 199 | } |
| 200 | |
| 201 | ################### |
| 202 | # Local profiles: # |
| 203 | ################### |
| 204 | |
| 205 | $Profiles->{'DE'} = # Deutschland |
| 206 | { |
| 207 | # For labeling only (defaults, may be overridden): |
| 208 |