File Coverage

blib/lib/DateTimeX/ISO8601/Interval.pm

Criterion	Covered	Total	%
statement	220	230	95.6
branch	124	146	84.9
condition	46	61	75.4
subroutine	25	25	100.0
pod	11	11	100.0
total	426	473	90.0

package DateTimeX::ISO8601::Interval;
BEGIN {
  $DateTimeX::ISO8601::Interval::AUTHORITY = 'cpan:BPHILLIPS';
}
$DateTimeX::ISO8601::Interval::VERSION = '0.003';
# ABSTRACT: Provides a means of parsing and manipulating ISO-8601 intervals and durations.

use strict;
use warnings;
use DateTime::Format::ISO8601;
use DateTime::Duration;
use Params::Validate qw(:all);
use Carp qw(croak);
use overload (
	'""' => sub { shift->format }
);

my $REPEAT    = qr{R(\d*)};
my $UNIT      = qr{(?:\d+)};
my $DURATION  = qr[
		P
		(?:
			(?:(${UNIT})Y)?
			(?:(${UNIT})M)?
			(?:(${UNIT})W)?
			(?:(${UNIT})D)?
		)
		(?:
			T
			(?:(${UNIT})H)?
			(?:(${UNIT})M)?
			(?:(${UNIT})S)?
		)?
	]x;

sub _determine_precision {
	my($date, $duration) = @_;
	return $date =~ m{T} ? 'time' : ($duration && !$duration->clock_duration->is_zero ? 'time' : 'date');
}


sub parse {
	my $class    = shift;
	my $interval = shift;
	my %args     = @_;

	my $input = $interval or croak "Nothing found to parse";

	if($interval =~ s{^R(\d*)/}{}){
		$args{repeat} = $1 ne '' ? $1 : -1;
	}
	my $parser = DateTime::Format::ISO8601->new;
	if($interval =~ s{^$DURATION/}{}){
		$args{duration} = _duration_from_matches([$1,$2,$3,$4,$5,$6,$7], %args);
		$args{precision} = _determine_precision($interval, $args{duration});
		$args{end} = $parser->parse_datetime($interval);
	} elsif($interval =~ s{/$DURATION$}{}){
		$args{duration} = _duration_from_matches([$1,$2,$3,$4,$5,$6,$7], %args);
		$args{precision} = _determine_precision($interval, $args{duration});
		$args{start} = $parser->parse_datetime($interval);
	} elsif($interval =~ m{^$DURATION$}){
		$args{duration} = _duration_from_matches([$1,$2,$3,$4,$5,$6,$7], %args);
	} elsif($interval =~ m{^(.+?)(?:--|/)(.+?)$}){
		$args{start} = $parser->parse_datetime($1);
		$parser->set_base_datetime(object => $args{start});
		my $end = substr($1,0,length($2) * -1) . $2;
		$args{precision} = _determine_precision($end);
		$args{end}   = $parser->parse_datetime($end);
	}
	if(!$args{start} && !$args{end} && !$args{duration}){
		croak "Invalid interval: $input";
	}
	if($args{time_zone}){
		if(DateTime::TimeZone->is_valid_name($args{time_zone})){
			for my $d (grep { defined } @args{'start','end'}) {
				$d->set_time_zone($args{time_zone})
			}
		} else {
			croak "Invalid time_zone: $args{time_zone}";
		}
	}
	delete @args{grep { !defined $args{$_} } keys %args};
	return $class->new(%args);
}

sub _duration_from_matches {
	my $matches = shift;
	my %args    = @_;
	my @positions = qw(years months weeks days hours minutes seconds);
	my %params;
	for my $i(0..$#positions) {
		$params{$positions[$i]} = $matches->[$i] if $matches->[$i];
	}
	return DateTime::Duration->new(%params, end_of_month => $args{end_of_month} || 'limit');
}


sub new {
	my $class = shift;
	my %args = validate(
		@_,
		{
			precision  => { default  => 'time' },
			start      => { optional => 1, isa => 'DateTime' },
			end        => { optional => 1, isa => 'DateTime' },
			duration   => { optional => 1, isa => 'DateTime::Duration' },
			time_zone  => { optional => 1, type => SCALAR | OBJECT },
			abbreviate => { optional => 1, type => BOOLEAN, default => 0 },
			repeat => {
				optional => 1,
				type     => SCALAR,
				regex    => qr{^(-1|\d+)$},
				default  => 0
			}
		}
	);

	if(!$args{duration} && (!$args{start} || !$args{end})){
		croak "Either a duration or a start or end parameter must be specified";
	}

	if($args{time_zone}){
		if(!ref($args{time_zone})){
			if(DateTime::TimeZone->is_valid_name($args{time_zone})){
				$args{time_zone} = DateTime::TimeZone->new( name => $args{time_zone} );
			} else {
				croak "Invalid time_zone: $args{time_zone}";
			}
		} elsif(!eval { $args{time_zone}->isa('DateTime::TimeZone') }){
			croak "Invalid time_zone: $args{time_zone}";
		}
	}

	return bless \%args, $class;
}


sub start {
	my $self = shift;
	my($input) = validate_pos(@_, { type => SCALAR | OBJECT, optional => 1 });

	if($input && !ref($input)){
		$self->{precision} = _determine_precision($input);
		my $parser = DateTime::Format::ISO8601->new;
		$input = $parser->parse_datetime($input) or croak "invalid start date: $input";
		if($self->{time_zone}){
			$input->set_time_zone($self->{time_zone});
		}
	}

	if($input) {
		$self->{start} = $input;
		delete $self->{duration} if($self->{end});
	}

	return $self->{start} || ($self->{end} ? ($self->{end} - $self->{duration}) : undef);
}


sub end {
	my $self = shift;

	my($input) = validate_pos(@_, { type => SCALAR | OBJECT, optional => 1 });

	if($input){
		if(!ref($input)){
			$self->{precision} = _determine_precision($input);
			my $parser = DateTime::Format::ISO8601->new;
			$input = $parser->parse_datetime($input) or croak "invalid end date: $input";
			if($self->{time_zone}){
				$input->set_time_zone($self->{time_zone});
			}
		} else {
			$self->{precision} = 'time';
		}
	}

	if($input) {
		$self->{end} = $input;
		delete $self->{duration} if($self->{start});
	}

	if(my $end = $self->{end}) {
		$end = $end->clone;
		if($self->{precision} eq 'date') {
			# if only specifying a date in an interval (i.e. 2013-12-01), the date/time equivalent
			# is actually considered the full day (i.e. 2013-12-01T24:00:00)
			$end += DateTime::Duration->new(days => 1);
		}
		return $end;
	} else {
		return $self->start + $self->duration;
	}
}


sub duration {
	my $self = shift;
	my($duration) = validate_pos(@_, { isa => 'DateTime::Duration', optional => 1 });
	if($duration){
		if($self->{start} && $self->{end}){
			croak "An explicit interval (with both start and end dates defined) can not have its duration changed";
		} else {
			$self->{duration} = $duration;
		}
	}
	return $self->{duration} if $self->{duration};
	my $dur = $self->{end} - $self->start;
	if($self->{precision} eq 'date'){
		$dur += DateTime::Duration->new(days => 1);
	}
	return $dur;
}


sub repeat {
	my $self = shift;

	my($repeat) = validate_pos(@_, { type => SCALAR, regex => qr{^(-1|\d+)$}, optional => 1 });

	if(defined $repeat){
		$self->{repeat} = $_[0];
	}
	return $self->{repeat};
}


sub iterator {
	my $self = shift;
	my %args = @_;

	my $counter = delete($args{skip}) || 0;
	croak "Invalid 'skip' parameter (must be >= 0 if specified)" if $counter < 0;

	my $start = ($self->start || $args{after}) or croak "This interval has no starting point";
	my $duration = $self->duration;

	if(my $after = delete($args{after})){
		croak "Invalid 'after' parameter (must be a finite DateTime object)" unless ( eval { $after->isa('DateTime') && $after->is_finite } );
		$counter++ while($start + ($duration * $counter) < $after);
	}

	my $until = delete($args{until});
	if($until){
		croak "Invalid 'until' paramter (must be a DateTime object)" unless eval { $until->isa('DateTime') };
		undef $until if $until->is_infinite; # ignore an infinite DateTime
	}

	my $repeat = $self->repeat || 1;

	my $class = ref $self;

	return sub {
		my $steps = shift || 1;
		$counter += ($steps - 1);
		return if $repeat >= 0 && $counter >= $repeat;

		my $this = $start + ($duration * $counter++);
		my $next = $start + ($duration * $counter);

		my $next_interval = $class->new( start => $this, end => $next );
		if($until && $next_interval->contains($until)){
			$repeat = 0; # this is the last one...
			$next_interval = undef;
		}
		return $next_interval;
	};
}


sub contains {
	my $self = shift;
	my($date) = validate_pos(@_, { type => SCALAR | OBJECT });
	croak "Unable to determine if this interval contains $date without an explicit start or end date" if !$self->{start} && !$self->{end};

	if(!ref($date)){
		my $parser = DateTime::Format::ISO8601->new;
		$date = $parser->parse_datetime($date);
		if(my $tz = $self->{time_zone}){
			$date->set_time_zone($tz);
		}
	}
	croak "Expecting a DateTime object" unless eval { $date->isa('DateTime') };
	if($self->{time_zone} && $date->time_zone->is_floating){
		$date = $date->clone;
		$date->set_time_zone($self->{time_zone});
	}
	return $self->start <= $date && $self->end > $date;
}


sub abbreviate {
	my $self = shift;
	$self->{abbreviate} = @_ ? $_[0] : 1;
	return $self;
}


sub format {
	my $self = shift;
	my %args = validate(
		@_,
		{
			abbreviate => {
				optional => 1,
				default  => $self->{abbreviate} || 0,
				type     => BOOLEAN
			}
		}
	);

	my @interval;

	if($self->{repeat}){
		if($self->{repeat} > 0){
			push @interval, 'R' . $self->{repeat};
		} else {
			push @interval, 'R';
		}
	}

	my $format = $self->{precision} eq 'date' ? 'yyyy-MM-dd' : 'yyyy-MM-ddTHH:mm:ss';
	my($start, $end) = @{$self}{'start','end'};
	if($self->{precision} ne 'date' && grep {$_ && $_->millisecond > 0} ($start, $end)){
		$format .= '.SSS';
	}
	if(defined $start){
		push @interval, $start->format_cldr($format) . $self->_timezone_offset($start);
	} else {
		push @interval, $self->_duration_stringify;
	}

	if(defined $end){
		my $formatted_end = $end->format_cldr($format) . $self->_timezone_offset($end);
		if($start && $args{abbreviate}) {
			my @parts = split(/(\D+)/, $formatted_end);
			my $same = '';
			foreach my $p(@parts) {
				if($p =~ /^\D+$/){
					$same .= $p;
				} elsif( index($interval[-1], "$same$p") == 0){
					$same .= $p;
				} else {
					last
				}
			}
			$formatted_end = substr($formatted_end, length($same));
		}
		push @interval, $formatted_end;
	} elsif( defined $start ){ # only use duration as "end" if start was defined
		push @interval, $self->_duration_stringify;
	}

	return join '/', @interval;
}


sub set_time_zone {
	my $self = shift;
	my $tz   = shift or croak "no time_zone specified";
	if(!eval { $tz->isa('DateTime::TimeZone') } && DateTime::TimeZone->is_valid_name($tz)){
		$tz = DateTime::TimeZone->new( name => $tz );
	}
	if(!ref($tz)){
		croak "invalid time zone: $tz";
	}

	$self->{time_zone} = $tz;

	foreach my $f(grep { exists $self->{$_} && $self->{$_} } qw(start end)){
		$self->{$f}->set_time_zone($tz);
	}
	return $self;
}

sub _timezone_offset {
	my $self = shift;
	my $date = shift;
	return '' if $self->{precision} eq 'date';
	return '' if $date->time_zone->is_floating;
	return 'Z' if $date->time_zone->is_utc;
	return $date->format_cldr('Z');
}

sub _duration_stringify {
	my $str = '';
	my $self = shift;
	my $d = $self->duration;
	$str .= 'P';
	foreach my $f(qw(years months weeks days)){
		my $number = $d->$f or next;
		my $unit = uc substr($f,0,1);
		$str .= $number . $unit;
	}
	my $has_time = 0;
	foreach my $f(qw(hours minutes seconds)){
		my $number = $d->$f or next;
		my $unit = uc substr($f,0,1);
		$str .= 'T' unless $has_time++;
		$str .= $number . $unit;
	}
	return $str;
}

1;

__END__