On 8/11/13 1:25 PM, Flavio S. Glock wrote:
http://search.cpan.org/dist/DateTime-Set/lib/DateTime/SpanSet.pm
next() and previous() can be used to determine whether a given point
in time falls between, before, or after the segments.
intersects() can tell whether a new segment would intersect existing segments.
Flavio, thank you for pointing me to that distribution. I have been
experimenting with DateTime::Span and find it helpful, but there's a
problem with DateTime::SpanSet -- or perhaps with my understanding of
that module.
Once again, my original problem:
2013/8/11 James E Keenan<jk...@verizon.net>:
I need to use DateTime functionality and would like to know
if the particular functionality I need already exists on
CPAN.
I need to construct a series of time segments which do not
overlap but which do not need to be contiguous. Each
segment is defined by a start date which is part of the
segment and by an end date which is the first moment in time
after the segment's conclusion.
I can use a start date and an end date to compose a DateTime::Span
object for each segment. (It turns out not to matter so much whether
the the segment is, in DT::S parlance, 'semi-open' or 'closed', i.e.,
whether I define the object with the second date with 'before' or with
'end'.)
However, I see that when (a) the end date of one segment is identical to
the start date of the next segment; and (b) I use DateTime::SpanSet to
create a spanset; then those two segments are, in effect, merged --
which seems counterintuitive. The only way I can get a spanset with the
same number of elements as the spans going in is to make sure that the
end date of one segment is one unit of time less than the start date of
the second segment.
The attached program, bspanset.pl, illustrates this problem. As a
convenience, I have divided the program into 7 sections named with roman
numerals.
In Section I, I create 4 pairs of DateTime objects. The end date of the
first pair is identical to the start date of the second pair. Likewise
for the third and fourth pairs. But there is a gap between the second
and third pairs. The output:
# I:
start: 2012-12-15T00:00:00 end: 2013-01-01T00:00:00
start: 2013-01-01T00:00:00 end: 2013-02-01T00:00:00
start: 2013-03-01T00:00:00 end: 2013-04-01T00:00:00
start: 2013-04-01T00:00:00 end: 2013-04-15T00:00:00
In Section II, I create DateTime::Span objects from each pair. I use
'before' to create semi-open objects.
# II:
start: 2012-12-15T00:00:00 end: 2013-01-01T00:00:00
start: 2013-01-01T00:00:00 end: 2013-02-01T00:00:00
start: 2013-03-01T00:00:00 end: 2013-04-01T00:00:00
start: 2013-04-01T00:00:00 end: 2013-04-15T00:00:00
In Section III, I create a DateTime::SpanSet object from the 4
DateTime::Span objects. But this SpanSet object only contains two
elements. The first and second have been merged, as have the third and
fourth.
# III:
start: 2012-12-15 end: 2013-02-01
start: 2013-03-01 end: 2013-04-15
In Sections IV an V, I repeat II and III, only with 'end' to create
closed objects. I still end up with only two elements in the
DateTime::SpanSet object.
# IV:
start: 2012-12-15T00:00:00 end: 2013-01-01T00:00:00
start: 2013-01-01T00:00:00 end: 2013-02-01T00:00:00
start: 2013-03-01T00:00:00 end: 2013-04-01T00:00:00
start: 2013-04-01T00:00:00 end: 2013-04-15T00:00:00
# V:
start: 2012-12-15 end: 2013-02-01
start: 2013-03-01 end: 2013-04-15
In Section VI, I subtract one second from the latter date in each pair,
then use that to create a closed object.
# VI:
start: 2012-12-15T00:00:00 end: 2012-12-31T23:59:59
start: 2013-01-01T00:00:00 end: 2013-01-31T23:59:59
start: 2013-03-01T00:00:00 end: 2013-03-31T23:59:59
start: 2013-04-01T00:00:00 end: 2013-04-14T23:59:59
In Section VII, I created a DateTime::SpanSet object from the four
DateTime::Span objects. Only now do I get what I intuitively thought I
should get, namely, a SpanSet object with four elements.
# VII:
start: 2012-12-15 end: 2012-12-31
start: 2013-01-01 end: 2013-01-31
start: 2013-03-01 end: 2013-03-31
start: 2013-04-01 end: 2013-04-14
Am I using DateTime::SpanSet correctly?
Thank you very much.
Jim Keenan
#!/usr/env/perl
use strict;
use warnings;
use 5.10.1;
use Carp;
use DateTime;
use DateTime::Span;
use DateTime::SpanSet;
use DateTime::Duration;
my ($pairs_out, $spansref, $spanset, $iter);
say "# I:\n";
$pairs_out = generate_all_pairs(
[
{ year => 2013, month => 2, day => 1},
{ year => 2013, month => 1, day => 1},
],
[
{ year => 2013, month => 3, day => 1},
{ year => 2013, month => 4, day => 1},
],
[
{ year => 2013, month => 4, day => 15},
{ year => 2013, month => 4, day => 1},
],
[
{ year => 2013, month => 1, day => 1},
{ year => 2012, month => 12, day => 15},
],
);
dump_all_pairs_sorted_by_start($pairs_out);
say "";
say "# II:\n";
$spansref = create_spans_from_pairs(
pairs => $pairs_out,
mode => 'before',
);
dump_spans($spansref);
say "# III:\n";
$spanset = DateTime::SpanSet->from_spans( spans => $spansref );
iterate_thru_spanset($spanset);
say "# IV:\n";
$spansref = create_spans_from_pairs(
pairs => $pairs_out,
mode => 'end',
);
dump_spans($spansref);
say "# V:\n";
$spanset = DateTime::SpanSet->from_spans( spans => $spansref );
iterate_thru_spanset($spanset);
say "# VI:\n";
$spansref = create_spans_from_pairs(
pairs => $pairs_out,
mode => 'minus',
);
dump_spans($spansref);
say "# VII:\n";
$spanset = DateTime::SpanSet->from_spans( spans => $spansref );
iterate_thru_spanset($spanset);
#################
sub generate_all_pairs {
# takes 1 or more array refs,
# each of which contains 2 hashrefs w/ keys: year month day
my @pairs_in = @_;
my @pairs_out;
for my $p (@pairs_in) {
my @dates;
croak "Each argument must be an arrayref" unless ref($p) eq 'ARRAY';
croak "Need exactly 2 hashrefs within each array ref" unless @{$p} == 2;
for my $d (@{$p}) {
croak "Argument must be hashref" unless ref($d) eq 'HASH';
for my $e ('year', 'month', 'day') {
croak "Hashref must have '$e' element" unless exists $d->{$e};
}
my $dt = DateTime->new(
year => $d->{year},
month => $d->{month},
day => $d->{day},
hour => 00,
minute => 00,
second => 00,
time_zone => 'America/New_York',
);
push @dates, $dt;
}
push @pairs_out, [ sort @dates ];
}
return \@pairs_out;
}
sub create_spans_from_pairs {
my %args = @_;
croak "Bad argument for 'mode'"
unless ($args{mode} eq 'before' or $args{mode} eq 'end'
or $args{mode} eq 'minus');
my @spans;
for my $pair (sort { $a->[0] <=> $b->[0] } @{$args{pairs}}) {
if ($args{mode} eq 'minus') {
my $dur = DateTime::Duration->new( seconds => 1 );
my $dtminus = $pair->[1]->clone()->subtract_duration($dur);;
push @spans,
DateTime::Span->from_datetimes(
start => $pair->[0],
end => $dtminus,
);
}
elsif ($args{mode} eq 'before') {
push @spans,
DateTime::Span->from_datetimes(
start => $pair->[0],
before => $pair->[1],
);
}
else {
push @spans,
DateTime::Span->from_datetimes(
start => $pair->[0],
end => $pair->[1],
);
}
}
return \@spans;
}
sub dump_all_pairs {
my $allpairs = shift;
for my $pair (@{$allpairs}) {
dump_start_and_end($pair);
}
}
sub dump_all_pairs_sorted_by_start {
my $allpairs = shift;
for my $pair (sort { $a->[0] <=> $b->[0] } @{$allpairs}) {
dump_start_and_end($pair);
}
}
sub dump_start_and_end {
my $pair = shift;
croak "Must pass arrayref" unless ref($pair) eq 'ARRAY';
say "start: ", $pair->[0], "\t", "end: ", $pair->[1];
}
sub dump_spans {
my $spansref = shift;
for my $e (@{$spansref}) {
say "start: ", $e->start, "\tend: ", $e->end;
}
say "";
}
sub iterate_thru_spanset {
my $spanset = shift;
my $iter = $spanset->iterator;
while ( my $dtspan = $iter->next ) {
say "start: ", $dtspan->start->ymd, "\tend: ", $dtspan->end->ymd;
};
say "";
}
