#!/usr/bin/perl
use strict;
use warnings;
use feature qw( :5.10 );
use DateTime;
use DateTime::Duration;
use DateTime::Set;
use DateTime::Span;
my $starting_date = { day => 5, hour => 0, minute => 0, second => 0 };
my $range_ref = { days => 5, hours => 20, minutes => 0, seconds => 0 };
my ($dt, $rv);
# Example 1: Date being tested is explicitly set
$dt = DateTime->new(
year => 2009,
month => 12,
day => 31,
hour => 12,
minute => 36,
second => 47,
);
$rv = validate( {
starting_date => $starting_date,
range => $range_ref,
target => $dt,
} );
$rv ? say "$dt is in range"
: say "$dt is not in range";
# Example 2: Date being tested is explicitly set
$dt = DateTime->new(
year => 2010,
month => 1,
day => 1,
hour => 12,
minute => 36,
second => 47,
);
$rv = validate( {
starting_date => $starting_date,
range => $range_ref,
target => $dt,
} );
$rv ? say "$dt is in range"
: say "$dt is not in range";
# Example 3: Test 'now'
$dt = DateTime->now();
$rv = validate( {
starting_date => $starting_date,
range => $range_ref,
target => $dt,
} );
$rv ? say "$dt is in range"
: say "$dt is not in range";
##### SUBROUTINES #####
sub validate {
my $args = shift;
my $sixdays = DateTime::Duration->new( days => 6 );
my $oneweek = DateTime::Duration->new( weeks => 1 );
my $dt1 = $args->{target}->clone();
$dt1->set(
hour => $args->{starting_date}->{hour},
minute => $args->{starting_date}->{minute},
second => $args->{starting_date}->{second},
);
my $starting_date_minus_6 = $dt1 - $sixdays;
my $spanweek = DateTime::Span->from_datetime_and_duration(
start => $starting_date_minus_6, duration => $oneweek );
my $set = DateTime::Set->from_recurrence(
recurrence => sub {
return $_[0] if $_[0]->is_infinite;
return $_[0]->add( days => 1 )
},
span => $spanweek,
);
my $start_of_span = _get_start_of_span( $args->{starting_date}, $set );
my $allowable_range = DateTime::Duration->new( %{ $args->{range} } );
my $span_allow = DateTime::Span->from_datetime_and_duration(
start => $start_of_span,
duration => $allowable_range
);
_date_is_in_span( $args->{target}, $span_allow );
}
sub _get_start_of_span {
my ($starting_date, $set) = @_;
my $iter = $set->iterator;
my $starting_dt;
while ( my $x = $iter->next ) {
if ( $x->dow eq $starting_date->{day} ) {
$starting_dt = $x->clone();
last;
}
};
return $starting_dt;
}
sub _date_is_in_span {
my ( $date, $span ) = @_;
$span->contains( $date ) ? 1 : 0;
}
The attached file, zinspan.pl, is my first attempt at using DateTime
to solve a practical problem. I am looking for feedback both on the
program's validity and on whether there is the making of a new
DateTime module in it.
Problem: Suppose that a 'week' can begin at an arbitrarily chosen
day of the week and time of day. Suppose further that that week can
be divided into two subspans: one in which an event is permitted to
occur, and the other in which the event is not permitted to occur.
Write a function that returns true if the event's date is in the
permitted subspan and false if it is in the forbidden subspan.
Example: A file is to be processed if it arrives on the system
anytime between Friday midnight and Wednesday 8:00 pm. The file has
arrived. Is it okay to process it?
Thank you very much.
Jim Keenan
