$VERSION
=
'1.41'
;
sub
new {
my
$that
=
shift
;
my
$class
=
ref
(
$that
) ||
$that
;
my
@dates
=
sort
{
$a
<=>
$b
}
grep
UNIVERSAL::isa(
$_
=>
$class
->want_class),
@_
;
croak
"You must create a range from two date objects"
unless
(
@dates
== 2);
my
$self
=
bless
{
_start
=>
$dates
[0],
_end
=>
$dates
[1],
},
$class
;
return
$self
;
}
sub
want_class {
'Date::Simple'
}
sub
start {
$_
[0]->{_start} }
sub
end {
$_
[0]->{_end} }
sub
length
{ (
int
(
$_
[0]->end -
$_
[0]->start) /
$_
[0]->_day_length) +1 }
sub
_day_length { 1 }
sub
equals {
my
(
$self
,
$check
) =
@_
;
return
unless
UNIVERSAL::isa(
$check
=>
'Date::Range'
);
return
(
$self
->start ==
$check
->start and
$self
->end ==
$check
->end);
}
sub
includes {
my
(
$self
,
$check
) =
@_
;
if
(UNIVERSAL::isa(
$check
=>
'Date::Range'
)) {
return
$self
->includes(
$check
->start) &&
$self
->includes(
$check
->end);
}
elsif
(
$check
->isa(
$self
->want_class)) {
return
$self
->start <=
$check
&&
$check
<=
$self
->end;
}
else
{
croak
"Ranges can only include dates or ranges"
;
}
}
sub
overlaps {
my
(
$self
,
$check
) =
@_
;
return
unless
UNIVERSAL::isa(
$check
=>
'Date::Range'
);
return
$check
->includes(
$self
->start) ||
$check
->includes(
$self
->end)
||
$self
->includes(
$check
);
}
sub
overlap {
my
(
$self
,
$check
) =
@_
;
return
unless
UNIVERSAL::isa(
$check
=>
'Date::Range'
);
return
unless
$self
->overlaps(
$check
);
my
@dates
=
sort
{
$a
<=>
$b
}
$self
->start,
$self
->end,
$check
->start,
$check
->end;
return
$self
->new(
@dates
[1..2]);
}
sub
gap {
my
(
$self
,
$range
) =
@_
;
return
if
$self
->overlaps(
$range
);
my
@sorted
=
sort
{
$a
->start <=>
$b
->start } (
$self
,
$range
);
my
$start
=
$sorted
[0]->end +
$self
->_day_length;
my
$end
=
$sorted
[1]->start -
$self
->_day_length;
return
if
$start
>=
$end
;
return
$self
->new(
$start
,
$end
);
}
sub
abuts {
my
(
$self
,
$range
) =
@_
;
return
! (
$self
->overlaps(
$range
) ||
$self
->gap(
$range
));
}
sub
dates {
my
$self
=
shift
;
my
@dates
;
my
$start
=
$self
->start;
for
(1..
$self
->
length
) {
push
@dates
,
$start
;
$start
+=
$self
->_day_length;
}
return
@dates
;
}
1;
=head1 AUTHOR
Tony Bowden, based heavily on Martin Fowler's
"Analysis Patterns 2"
=head1 BUGS and QUERIES
Please direct all correspondence regarding this module to:
bug-Date-Range
@rt
.cpan.org
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2001-2006 Tony Bowden.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License; either version
2 of the License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.