File Coverage

blib/lib/Date/Lectionary/Time.pm
Criterion Covered Total %
statement 65 70 92.8
branch 16 18 88.8
condition 5 9 55.5
subroutine 14 17 82.3
pod 3 3 100.0
total 103 117 88.0


line stmt bran cond sub pod time code
1             package Date::Lectionary::Time;
2              
3 4     4   242890 use v5.22;
  4         11  
4 4     4   21 use strict;
  4         4  
  4         59  
5 4     4   11 use warnings;
  4         9  
  4         101  
6              
7 4     4   1714 use Exporter::Easy ( OK => [qw(nextSunday prevSunday closestSunday)], );
  4         4189  
  4         23  
8              
9 4     4   376 use Carp;
  4         4  
  4         191  
10 4     4   1790 use Try::Tiny;
  4         6002  
  4         183  
11 4     4   491 use Time::Piece;
  4         8325  
  4         19  
12 4     4   250 use Time::Seconds;
  4         5  
  4         1805  
13              
14             =head1 NAME
15              
16             Date::Lectionary::Time - Find your way in time relative to Sundays.
17              
18             =head1 VERSION
19              
20             Version 1.20161222
21              
22             =cut
23              
24             our $VERSION = '1.20161222';
25              
26             =head1 SYNOPSIS
27              
28             Working in the liturgical time of the lectionary means tracking time relative to Sundays. This is a quick utility to find the next, previous, or the closest Sunday to a given date.
29              
30             use Time::Piece;
31             use Date::Lectionary::Time qw(nextSunday prevSunday closestSunday);
32              
33             my $christmasDay = Time::Piece->strptime("2015-12-25", "%Y-%m-%d");
34             my $sundayAfterChristmas = nextSunday($christmasDay);
35             my $sundayBeforeChristmas = prevSunday($christmasDay);
36             my $sundayClosestToChristmas = closestSunday($christmasDay);
37              
38             =head1 EXPORTS
39              
40             nextSunday
41              
42             prevSunday
43              
44             closestSunday
45              
46             use Date::Lectionary::Time qw(nextSunday prevSunday closestSunday);
47              
48             =head1 SUBROUTINES/METHODS
49              
50             =head2 nextSunday
51              
52             For a given Time::Piece date returns a Time::Piece object of the date of the Sunday immediately following the given date.
53              
54             =cut
55              
56             sub nextSunday {
57 11     11 1 88593 my ( $class, @params ) = @_;
58 11   66     103 my $date = $params[0] // $class;
59 11         110 my $nextSunday = undef;
60              
61 11 100       19 if ( !length $date ) {
62 1         15 croak
63             "Method [nextSunday] expects an input argument of type Time::Piece. The given type could not be determined.";
64             }
65              
66 10 100       102 if ( $date->isa('Time::Piece') ) {
67             try {
68 9     9   421 my $daysToAdd = 7 - $date->_wday;
69 9         31 my $secondsToAdd = $daysToAdd * ONE_DAY;
70 9         33 $nextSunday = $date + $secondsToAdd;
71             }
72             catch {
73 0     0   0 croak "Could not calculate the next Sunday after $date.";
74 9         52 };
75             }
76             else {
77 1         22 croak
78             "Method [nextSunday] expects an input argument of type Time::Piece.";
79             }
80              
81 9         448 return $nextSunday;
82             }
83              
84             =head2 prevSunday
85              
86             For a given Time::Piece date returns a Time::Piece object of the date of the Sunday immediately before the given date.
87              
88             =cut
89              
90             sub prevSunday {
91 11     11 1 86546 my ( $class, @params ) = @_;
92 11   66     97 my $date = $params[0] // $class;
93 11         110 my $prevSunday = undef;
94              
95 11 100       18 if ( !length $date ) {
96 1         8 croak
97             "Method [prevSunday] expects an input argument of type Time::Piece. The given type could not be determined.";
98             }
99              
100 10 100       98 if ( $date->isa('Time::Piece') ) {
101             try {
102 9     9   399 my $daysToSubtract = $date->_wday;
103 9 100       46 if ( $daysToSubtract == 0 ) { $daysToSubtract = 7; }
  2         3  
104 9         11 my $secondsToSubtract = $daysToSubtract * ONE_DAY;
105 9         22 $prevSunday = $date - $secondsToSubtract;
106             }
107             catch {
108 0     0   0 carp "Could not calculate the previous Sunday before $date.";
109 9         56 };
110             }
111             else {
112 1         17 croak
113             "Method [prevSunday] expects an input argument of type Time::Piece.";
114             }
115              
116 9         447 return $prevSunday;
117             }
118              
119             =head2 closestSunday
120              
121             For a given Time::Piece date returns a Time::Piece object of the date of the Sunday closest to the given date.
122              
123             =cut
124              
125             sub closestSunday {
126 4     4 1 85100 my ( $class, @params ) = @_;
127 4   33     70 my $date = $params[0] // $class;
128 4         54 my $closestSunday = undef;
129              
130 4 50       8 if ( !length $date ) {
131 0         0 croak
132             "Method [closestSunday] expects an input argument of type Time::Piece. The given type could not be determined.";
133             }
134              
135 4 50       46 if ( $date->isa('Time::Piece') ) {
136             try {
137 4     4   197 my $nextSunday = nextSunday($date);
138 4         8 my $prevSunday = prevSunday($date);
139              
140 4         5 my ( $dif1, $dif2 );
141              
142 4         8 $dif1 = abs( $date - $nextSunday );
143 4         185 $dif2 = abs( $prevSunday - $date );
144              
145 4 100       109 if ( $dif1 < $dif2 ) {
    100          
146 2         26 $closestSunday = $nextSunday;
147             }
148             elsif ( $dif1 == $dif2 ) {
149 1         20 $closestSunday = $date;
150             }
151             else {
152 1         20 $closestSunday = $prevSunday;
153             }
154             }
155             catch {
156 0     0   0 carp "Could not calculate the Sunday closest to $date.";
157 4         24 };
158             }
159             else {
160 0         0 croak
161             "Method [closestSunday] expects an input argument of type Time::Piece.";
162             }
163              
164 4         45 return $closestSunday;
165             }
166              
167             =head1 AUTHOR
168              
169             Michael Wayne Arnold, C<< >>
170              
171             =head1 BUGS
172              
173             Please report any bugs or feature requests to C, or through
174             the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
175              
176             =head1 SUPPORT
177              
178             You can find documentation for this module with the perldoc command.
179              
180             perldoc Date::Lectionary::Time
181              
182             The development of this module is hosted on GitHub -- L -- and tested via TravisCI.
183              
184             =for html
185              
186             =for html Coverage Status
187              
188             You can also look for information at:
189              
190             =over 4
191              
192             =item * RT: CPAN's request tracker (report bugs here)
193              
194             L
195              
196             =item * AnnoCPAN: Annotated CPAN documentation
197              
198             L
199              
200             =item * CPAN Ratings
201              
202             L
203              
204             =item * Search CPAN
205              
206             L
207              
208             =back
209              
210             =head1 ACKNOWLEDGEMENTS
211              
212             Many thanks to my beautiful wife, Jennifer, and my amazing daughter, Rosemary. But, above all, SOLI DEO GLORIA!
213              
214             =head1 LICENSE AND COPYRIGHT
215              
216             Copyright 2016 Michael Wayne Arnold.
217              
218             This program is free software; you can redistribute it and/or modify it
219             under the terms of either: the GNU General Public License as published
220             by the Free Software Foundation; or the Artistic License.
221              
222             See L for more information.
223              
224              
225             =cut
226              
227             1; # End of Date::Lectionary::Time