File Coverage

blib/lib/Date/Range.pm
Criterion Covered Total %
statement 51 52 98.0
branch 12 18 66.6
condition 15 18 83.3
subroutine 15 15 100.0
pod 12 12 100.0
total 105 115 91.3


line stmt bran cond sub pod time code
1             package Date::Range;
2              
3             =head1 NAME
4              
5             Date::Range - work with a range of dates
6              
7             =head1 SYNOPSIS
8              
9             use Date::Range;
10              
11             my $range = Date::Range->new($date1, $date2);
12              
13             my $earliest = $range->start;
14             my $latest = $range->end;
15             my $days = $range->length;
16              
17             if ($range->includes($date3)) { ... }
18             if ($range->includes($range2)) { ... }
19              
20             if ($range->overlaps($range2)) {
21             my $range3 = $range->overlap($range2);
22             }
23              
24             foreach my $date ($range->dates) { ... }
25              
26             =head1 DESCRIPTION
27              
28             Quite often, when dealing with dates, we don't just want to know
29             information about one particular date, but about a range of dates. For
30             example, we may wish to know whether a given date is in a particular
31             range, or what the overlap is between one range and another. This module
32             lets you ask such questions.
33              
34             =cut
35              
36             $VERSION = '1.41';
37              
38 1     1   41938 use strict;
  1         4  
  1         31  
39 1     1   4 use Carp;
  1         2  
  1         804  
40              
41              
42             =head1 METHODS
43              
44             =head2 new()
45              
46             my $range = Date::Range->new($date1, $date2);
47              
48             A range object is instantiated with two dates, which do not need
49             to be in chronological order (we'll sort all that out internally).
50              
51             These dates must be instances of the correct object. See want_class()
52             below.
53              
54             =head2 want_class
55              
56             The class of which we expect the date objects to be objects. By default
57             this is L, but this could be any other date class. See
58             L for an example of a subclass that uses a different
59             date class.
60              
61             =cut
62              
63             sub new {
64 22     22 1 2804 my $that = shift;
65 22   66     74 my $class = ref($that) || $that;
66 22         57 my @dates = sort { $a <=> $b } grep UNIVERSAL::isa($_ => $class->want_class), @_;
  21         63  
67 22 100       497 croak "You must create a range from two date objects" unless (@dates == 2);
68 18         59 my $self = bless {
69             _start => $dates[0],
70             _end => $dates[1],
71             }, $class;
72 18         64 return $self;
73             }
74              
75 116     116 1 347 sub want_class { 'Date::Simple' }
76              
77             =head2 start / end / length
78              
79             my $earliest = $range->start;
80             my $latest = $range->end;
81             my $days = $range->length;
82              
83             These methods allow you retrieve the start and end dates of the range,
84             and the number of days in the range.
85              
86             =cut
87              
88 179     179 1 1754 sub start { $_[0]->{_start} }
89 101     101 1 1007 sub end { $_[0]->{_end} }
90 6     6 1 14 sub length { (int ($_[0]->end - $_[0]->start) / $_[0]->_day_length) +1 }
91              
92 31     31   130 sub _day_length { 1 }
93              
94             =head2 equals
95              
96             if ($range1->equals($range2)) { }
97              
98             This tells you if two ranges are the same - i.e. start and end at
99             the same dates.
100              
101             =cut
102              
103             sub equals {
104 3     3 1 8 my ($self, $check) = @_;
105 3 50       12 return unless UNIVERSAL::isa($check => 'Date::Range');
106 3   66     7 return ($self->start == $check->start and $self->end == $check->end);
107             }
108              
109             =head2 includes
110              
111             if ($range->includes($date3)) { ... }
112             if ($range->includes($range2)) { ... }
113              
114             These methods tell you if a given range includes a given date,
115             or a given range.
116              
117             =cut
118              
119             sub includes {
120 95     95 1 149 my ($self, $check) = @_;
121 95 100       354 if (UNIVERSAL::isa($check => 'Date::Range')) {
    50          
122 21   66     34 return $self->includes($check->start) && $self->includes($check->end);
123             } elsif ($check->isa($self->want_class)) {
124 74   100     104 return $self->start <= $check && $check <= $self->end;
125             } else {
126 0         0 croak "Ranges can only include dates or ranges";
127             }
128             }
129              
130             =head2 overlaps / overlap
131              
132             if ($range->overlaps($range2)) {
133             my $range3 = $range->overlap($range2);
134             }
135              
136             These methods let you know whether one range overlaps another or not,
137             and access this overlap range.
138              
139             =cut
140              
141             sub overlaps {
142 26     26 1 37 my ($self, $check) = @_;
143 26 50       70 return unless UNIVERSAL::isa($check => 'Date::Range');
144 26   100     35 return $check->includes($self->start) || $check->includes($self->end)
145             || $self->includes($check);
146             }
147              
148             sub overlap {
149 2     2 1 2 my ($self, $check) = @_;
150 2 50       8 return unless UNIVERSAL::isa($check => 'Date::Range');
151 2 50       3 return unless $self->overlaps($check);
152 2         5 my @dates = sort { $a <=> $b } $self->start, $self->end,
  10         17  
153             $check->start, $check->end;
154 2         6 return $self->new(@dates[1..2]);
155             }
156              
157             =head2 gap
158              
159             my $range3 = $range->gap($range2);
160              
161             This returns a new range representing the gap between two other ranges.
162              
163             =cut
164              
165             sub gap {
166 11     11 1 249 my ($self, $range) = @_;
167 11 50       20 return if $self->overlaps($range);
168 11         34 my @sorted = sort { $a->start <=> $b->start } ($self, $range);
  11         19  
169 11         24 my $start = $sorted[0]->end + $self->_day_length;
170 11         179 my $end = $sorted[1]->start - $self->_day_length;
171 11 100       179 return if $start >= $end;
172 4         21 return $self->new($start, $end);
173             }
174              
175             =head2 abuts
176              
177             if ($range->abuts($range2)) { ... }
178              
179             This tells you whether or not two ranges are contiguous - i.e. there is
180             no gap between them, but they do not overlap.
181              
182             =cut
183              
184             sub abuts {
185 9     9 1 1085 my ($self, $range) = @_;
186 9   100     15 return ! ($self->overlaps($range) || $self->gap($range));
187             }
188              
189             =head2 dates
190              
191             foreach my $date ($range->dates) { ... }
192              
193             This returns a list of each date in the range as a Date::Simple object.
194              
195             =cut
196              
197             sub dates {
198 2     2 1 4 my $self = shift;
199 2         3 my @dates;
200 2         3 my $start = $self->start;
201 2         7 for (1..$self->length) {
202 3         21 push @dates, $start;
203 3         6 $start += $self->_day_length;
204             }
205 2         37 return @dates;
206             }
207              
208             1;
209              
210             =head1 AUTHOR
211              
212             Tony Bowden, based heavily on Martin Fowler's "Analysis Patterns 2"
213             discussion and code at http://www.martinfowler.com/ap2/range.html
214              
215             =head1 BUGS and QUERIES
216              
217             Please direct all correspondence regarding this module to:
218             bug-Date-Range@rt.cpan.org
219              
220             =head1 COPYRIGHT AND LICENSE
221              
222             Copyright (C) 2001-2006 Tony Bowden.
223              
224             This program is free software; you can redistribute it and/or modify
225             it under the terms of the GNU General Public License; either version
226             2 of the License, or (at your option) any later version.
227              
228             This program is distributed in the hope that it will be useful,
229             but WITHOUT ANY WARRANTY; without even the implied warranty of
230             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
231              
232