File Coverage

blib/lib/Date/Holidays/DK.pm
Criterion Covered Total %
statement 24 24 100.0
branch 2 2 100.0
condition 3 3 100.0
subroutine 7 7 100.0
pod 2 2 100.0
total 38 38 100.0


line stmt bran cond sub pod time code
1             package Date::Holidays::DK;
2 1     1   35891 use strict;
  1         2  
  1         42  
3 1     1   6 use base qw(Exporter);
  1         1  
  1         146  
4              
5 1     1   998 use Date::Simple;
  1         11569  
  1         110  
6 1     1   809 use Date::Easter;
  1         4464  
  1         69  
7              
8 1     1   7 use vars qw($VERSION @EXPORT);
  1         2  
  1         400  
9             $VERSION = '0.03';
10             @EXPORT = qw(is_dk_holiday dk_holidays);
11              
12             # Fixed-date holidays
13             my $FIX = {'0101' => "Nytårsdag",
14             '0605' => "Grundlovsdag",
15             '1224' => "Juleaftensdag",
16             '1225' => "Juledag",
17             '1226' => "2. Juledag",
18             };
19              
20             # Holidays relative to Easter
21             my $VAR = {-7 => "Palmesøndag",
22             -3 => "Skærtorsdag",
23             -2 => "Langfredag",
24             0 => "Påskedag",
25             1 => "2. Påskedag",
26             26 => "Store Bededag",
27             39 => "Kristi Himmelfartsdag",
28             49 => "Pinsedag",
29             50 => "2. Pinsedag",
30             };
31              
32             sub is_dk_holiday {
33 20     20 1 14572 my ($year, $month, $day) = @_;
34              
35 20 100 100     153 $FIX->{sprintf "%02d%02d", $month, $day} ||
36             $VAR->{Date::Simple->new($year, $month, $day) -
37             Date::Simple->new($year, easter($year))} ||
38             undef;
39             }
40              
41             sub dk_holidays {
42 1     1 1 829 my ($year) = @_;
43              
44             # get the fixed dates
45 1         8 my $h = {%$FIX};
46              
47 1         5 my $easter = Date::Simple->new($year, easter($year));
48              
49             # build the relative dates
50 1         41 foreach my $diff (keys %$VAR) {
51 9         69 my $date = $easter + $diff;
52 9         925 $h->{sprintf "%02d%02d", $date->month, $date->day} = $VAR->{$diff};
53             }
54              
55 1         8 return $h;
56             }
57              
58             1;
59              
60             =head1 NAME
61              
62             Date::Holidays::DK - Determine Danish public holidays
63              
64             =head1 SYNOPSIS
65              
66             use Date::Holidays::DK;
67             my ($year, $month, $day) = (localtime)[ 5, 4, 3 ];
68             $year += 1900;
69             $month += 1;
70             print "Woohoo" if is_dk_holiday( $year, $month, $day );
71              
72             my $h = dk_holidays($year);
73             printf "Dec. 25th is named '%s'\n", $h->{'1225'};
74              
75             =head1 DESCRIPTION
76              
77             Determines whether a given date is a Danish public holiday or not.
78              
79             This module is based on the simple API of Date::Holidays::UK, but
80             implements a generalised date mechanism, that will work for all
81             years since 1700, when Denmark adopted the Gregorian calendar.
82              
83             =head1 Functions
84              
85             =over 4
86              
87             =item is_dk_holiday($year, $month, $date)
88              
89             Returns the name of the Holiday that falls on the given day, or undef
90             if there is none.
91              
92             =item dk_holidays($year)
93              
94             Returns a hashref of all defined holidays in the year. Keys in the
95             hashref are in 'mmdd' format, the values are the names of the
96             holidays.
97              
98             =back
99              
100             =head1 EXPORTS
101              
102             Exports is_dk_holiday() and dk_holidays() by default.
103              
104             =head1 BUGS
105              
106             Please report issues via CPAN RT:
107              
108             http://rt.cpan.org/NoAuth/Bugs.html?Dist=Date-Holidays-DK
109              
110             or by sending mail to
111              
112             bug-Date-Holidays-DK@rt.cpan.org
113              
114             =head1 AUTHORS
115              
116             Lars Thegler . Originally inspired by
117             Date::Holidays::UK by Richard Clamp.
118              
119             dk_holidays() concept by Jonas B. Nielsen.
120              
121             =head1 COPYRIGHT
122              
123             Copyright (c) 2004-2005 Lars Thegler. All rights reserved.
124              
125             This program is free software; you can redistribute it and/or modify
126             it under the same terms as Perl itself.
127              
128             =cut
129