File Coverage

blib/lib/Date/Holidays/PT.pm
Criterion Covered Total %
statement 42 42 100.0
branch 12 12 100.0
condition 3 3 100.0
subroutine 9 9 100.0
pod 4 4 100.0
total 70 70 100.0


line stmt bran cond sub pod time code
1             package Date::Holidays::PT;
2              
3 5     5   166786 use warnings;
  5         13  
  5         211  
4 5     5   29 use strict;
  5         10  
  5         364  
5              
6 5     5   5483 use Date::Holidays::Super;
  5         991  
  5         236  
7 5     5   5830 use Date::Easter;
  5         22312  
  5         334  
8 5     5   6248 use Time::JulianDay;
  5         48279  
  5         3297  
9              
10             my @ISA = qw(Date::Holidays::Super);
11              
12             =head1 NAME
13              
14             Date::Holidays::PT - Determine Portuguese public holidays
15              
16             =cut
17              
18             our $VERSION = '0.02';
19              
20             =head1 SYNOPSIS
21              
22             use Date::Holidays::PT;
23             my ($year, $month, $day) = (localtime)[ 5, 4, 3 ];
24             $year += 1900;
25             $month += 1;
26             print "Woohoo" if is_pt_holiday( $year, $month, $day );
27              
28             my $h = pt_holidays($year);
29             printf "Jan. 1st is named '%s'\n", $h->{'0101'};
30              
31             =head1 FUNCTIONS
32              
33             =head2 new
34              
35             Creates a new Date::Holidays::PT object.
36              
37             my $mh = Date::Holidays::PT->new();
38              
39             =cut
40              
41             sub new {
42 4     4 1 59 my $self = shift;
43 4         21 bless \$self => $self;
44             }
45              
46             =head2 is_holiday
47              
48             Should at least take three arguments:
49              
50             year (four digits)
51             month (between 1-12)
52             day (between 1-31)
53              
54             The return value from is_holiday is either a 1 or a 0 (1 if the
55             specified date is a holiday, 0 otherwise).
56              
57             if ( $mh->is_holiday( $year, $month, $day ) ) {
58             # it's a holiday
59             }
60              
61             =cut
62              
63             sub is_holiday {
64 36     36 1 69 my $self = shift;
65 36         102 return $self->is_pt_holiday(@_);
66             }
67              
68             =head2 is_pt_holiday
69              
70             Similar to is_holiday, but instead of returning 1 if the date is a
71             holiday returns a string comprising the name of the holidays. In the
72             event of two or more holidays on the same day (hey, it happens), the
73             string will comprise the name of all those holidays separated by a
74             semicolon.
75              
76             my $todays_holiday = $mh->is_pt_holiday( $year, $month, $day );
77             if ( $todays_holiday ) {
78             print "Today is $todays_holiday.\nDon't bother getting up!\n";
79             }
80              
81             =cut
82              
83             sub is_pt_holiday {
84 1144     1144 1 2881 my $self = shift;
85 1144         2453 my ($year, $month, $day) = @_;
86 1144 100       3052 defined $year || return undef;
87 1141 100       2291 defined $month || return undef;
88 1138 100       7477 defined $day || return undef;
89              
90 1135         4103 my $holidays = $self->holidays($year);
91 1135 100 100     8634 if (defined $holidays->{$month} and defined $holidays->{$month}{$day}) {
92 81         2049 return $holidays->{$month}{$day};
93             }
94             else {
95 1054         15025 return undef;
96             }
97              
98             }
99              
100             =head2 holidays
101              
102             Should take at least one argument:
103              
104             year (four digits)
105              
106             Returns a reference to a hash, where the keys are date represented as
107             four digits, the two first representing month (01-12) and the last two
108             representing day (01-31).
109              
110             The value for the key in question is the local name for the holiday
111             indicated by the day. In the event of two or more holidays on the same
112             day (yes, it happens!), the values will comprise the name of all those
113             holidays separated by a semicolon.
114              
115             my $years_holidays = holidays( $year );
116             for (keys %$years_holidays) {
117             my ($day, $month) = /(..)(..)/;
118             print "$day/$month - $years_holidays->$_\n";
119             }
120              
121             =cut
122              
123             sub holidays {
124 1142     1142 1 1670 my $self = shift;
125 1142         2084 my $year = shift;
126 1142 100       2297 defined $year || return undef;
127              
128 1141         18021 my %holidays = (
129             1 => {
130             1 => 'Ano Novo',
131             },
132             4 => {
133             25 => 'Dia da Liberdade',
134             },
135             5 => {
136             1 => 'Dia do Trabalhador',
137             },
138             6 => {
139             10 => 'Dia de Portugal, de Camões e das Comunidades',
140             },
141             8 => {
142             15 => 'Assunção da Virgem',
143             },
144             10 => {
145             5 => 'Dia da Implantação da República',
146             },
147             11 => {
148             1 => 'Dia de Todos-os-Santos',
149             },
150             12 => {
151             1 => 'Dia da Restauração da Independência',
152             8 => 'Imaculada Conceição',
153             25 => 'Natal',
154             },
155             );
156              
157 1141         4784 my ($emonth, $eday) = gregorian_easter($year);
158 1141         19498 $holidays{$emonth}{$eday} = 'Páscoa';
159              
160 1141         3731 my $jd = julian_day($year, $emonth, $eday);
161              
162 1141         14902 my (undef, $cmonth, $cday) = inverse_julian_day($jd - 47);
163 1141         22653 $holidays{$cmonth}{$cday} = 'Entrudo';
164              
165 1141         3475 my (undef, $bmonth, $bday) = inverse_julian_day($jd + 60);
166 1141 100       20765 $holidays{$bmonth}{$bday} =
167             $holidays{$bmonth}{$bday} ?
168             $holidays{$bmonth}{$bday} . '; Corpo de Deus':
169             'Corpo de Deus';
170              
171 1141         3366 my (undef, $smonth, $sday) = inverse_julian_day($jd - 2);
172 1141         18418 $holidays{$smonth}{$sday} = 'Sexta-feira Santa';
173              
174 1141         4283 return \%holidays;
175             }
176              
177             =head1 NATIONAL HOLIDAYS
178              
179             The following Portuguese holidays have fixed dates:
180              
181             Jan 1 Ano Novo
182             Apr 25 Dia da Liberdade
183             May 1 Dia do Trabalhador
184             Jun 10 Dia de Portugal, de Camões e das Comunidades
185             Aug 15 Assunção da Virgem
186             Oct 5 Dia da Implantação da República
187             Nov 1 Dia de Todos-os-Santos
188             Dec 1 Dia da Restauração da Independência
189             Dec 8 Imaculada Conceição
190             Dec 25 Natal
191              
192             The following Portuguese holidays have mobile dates:
193              
194             Entrudo (47 days before Páscoa / Easter)
195             Sexta-feira Santa (Friday before Páscoa / Easter)
196             Páscoa (Easter)
197             Corpo de Deus (60 days after Páscoa / Easter)
198              
199             =head1 ACKNOWLEDGEMENTS
200              
201             Paulo Rocha, for all his knowledge about holidays and everything else.
202              
203             Jonas B. Nielsen, for his work regarding the standardization of
204             Date::Holidays modules.
205              
206             =head1 AUTHOR
207              
208             Jose Castro, C<< >>
209              
210             =head1 BUGS
211              
212             Please report any bugs or feature requests to
213             C, or through the web interface at
214             L. I will be notified, and then you'll
215             automatically be notified of progress on your bug as I make changes.
216              
217             =head1 COPYRIGHT & LICENSE
218              
219             Copyright 2004 Jose Castro, All Rights Reserved.
220              
221             This program is free software; you can redistribute it and/or modify
222             it under the same terms as Perl itself.
223              
224             =cut
225              
226             1; # End of Date::Holidays::PT