File Coverage

blib/lib/Date/Easy/Datetime.pm

Criterion	Covered	Total	%
statement	157	160	98.1
branch	69	80	86.2
condition	34	39	87.1
subroutine	59	59	100.0
pod	34	34	100.0
total	353	372	94.8

package Date::Easy::Datetime;

use strict;
use warnings;
use autodie;

our $VERSION = '0.09_01'; # TRIAL VERSION

use Exporter;
use parent 'Exporter';
our @EXPORT_OK = qw< datetime now >;
our %EXPORT_TAGS = ( all => \@EXPORT_OK );

use Carp;
use Time::Piece;
use Scalar::Util 'blessed';
use Time::Local 1.26, qw< timegm_modern timelocal_modern >;


# this can be modified (preferably using `local`) to use GMT/UTC as the default
# or you can pass a value to `import` via your `use` line
our $DEFAULT_ZONE = 'local';

my %ZONE_FLAG = ( local => 1, UTC => 0, GMT => 0 );


sub import
{
	my @args;
	exists $ZONE_FLAG{$_} ? $DEFAULT_ZONE = $_ : push @args, $_ foreach @_;
	@_ = @args;
	goto &Exporter::import;
}


##############################
# FUNCTIONS (*NOT* METHODS!) #
##############################

sub datetime
{
	my $zonespec = @_ % 2 == 0 ? shift : $DEFAULT_ZONE;
	my $datetime = shift;
	if ( $datetime =~ /^-?\d+$/ )
	{
		return Date::Easy::Datetime->new($zonespec, $datetime);
	}
	else
	{
		my $t = _str2time($datetime, $zonespec);
		$t = _parsedate($datetime, $zonespec) unless defined $t;
		croak("Illegal datetime: $datetime") unless defined $t;
		return Date::Easy::Datetime->new( $zonespec, $t );
	}
	die("reached unreachable code");
}

sub now () { Date::Easy::Datetime->new }


sub _strptime
{
	require Date::Parse;
	# Most of this code is stolen from Date::Parse, by Graham Barr.  It is used here (see _str2time,
	# below), but its true raison d'etre is for use by Date::Easy::Date.
	#
	# In an ideal world, I would just use the code from Date::Parse and not repeat it here.
	# However, the problem is that str2time() calls strptime() to generate the pieces of a datetime,
	# then does some validation, then returns epoch seconds by calling timegm (from Time::Local) on
	# it.  For dates, I don't _want_ to call str2time because I'm just going to take the epoch
	# seconds and turn them back into pieces, so it's inefficicent.  But more importantly I _can't_
	# call str2time because it converts to UTC, and I want the pieces as they are relative to
	# whatever timezone the parsed date has.
	#
	# On the other hand, the problem with calling strptime directly is that str2time is doing two
	# things there: the conversion to epoch seconds, which I don't want or need for dates, and the
	# validation, which, it turns out, I *do* want, and need, even for dates.  For instance,
	# strptime will happily return a month of -1 if it hits a parsing hiccough.  Which then str2time
	# will turn into undef, as you would expect.  But, if you're just calling strptime, that doesn't
	# help you much. :-(
	#
	# Thus, for dates in particular, I'm left with 3 possibilities, none of them very palatable:
	# 	#	call strptime, then call str2time as well
	#	#	repeat at least some of the code from str2time here
	#	#	do Something Devious, like wrap/monkey-patch strptime
	# #1 doesn't seem practical, because it means that every string that has to be parsed this way
	# has to be parsed twice, meaning it will take twice as long.  #3 seems too complex--since the
	# call to strptime is out of my control, I can't add arguments to it, or get any extra data out
	# of it, which means I have to store things in global variables, which means it wouldn't be
	# reentrant ... it would be a big mess.  So #2, unpalatable as it is, is what we're going with.
	#
	# Of course, this gives me the opportunity to tweak a few things.  Primarily, we can tweak our
	# code to fix RT/105031 et al (see comments below, in _str2time).  There's a few minor
	# efficiency gains we can get from not doing things the older code seemed to think was
	# necessary.  (Of course, maybe it really is, in which case I'll have to put it all back.)
	#
	# The code in _strptime is as much of Date::Parse::str2time as is necessary to handle all the
	# validation and still return separate time values.  This way it can be used by both dates and
	# datetimes.

	my ($str, $zonespec) = @_;

	my ($sec, $min, $hour, $day, $month, $year, $zone)
			= Date::Parse::strptime($str, $zonespec eq 'local' ? () : $zonespec);
	my $num_defined = defined($day) + defined($month) + defined($year);
	return () if $num_defined == 0;
	if ($num_defined < 3)
	{
		my @lt  = localtime(time);

		$month = $lt[4] unless defined $month;
		$day  = $lt[3] unless defined $day;
		$year = ($month > $lt[4]) ? ($lt[5] - 1) : $lt[5] unless defined $year;
	}
	$hour ||= 0; $min ||= 0; $sec ||= 0;			# default time components to zero
	my $subsec = $sec - int($sec); $sec = int($sec);# extract any fractional part (e.g. milliseconds)
	$year += 1900 if $year < 1000;					# undo timelocal funkiness and adjust for RT/53413 / RT/105031

	return () unless $month >= 0 and $month <= 11 and $day >= 1 and $day <= 31
						and $hour <= 23 and $min <= 59 and $sec <= 59;

	return ($sec, $min, $hour, $day, $month, $year, $zone, $subsec);
}

sub _str2time
{
	require Date::Parse;
	# Most of this code is also stolen from Date::Parse, by Graham Barr.  This is the remainder of
	# Date::Parse::str2time, which takes the separate values (from _strptime, above) and turns them
	# into an epoch seconds value.  See also the big comment block below.

	my ($time, $zonespec) = @_;
	my ($sec, $min, $hour, $day, $month, $year, $zone, $subsec) = _strptime($time, $zonespec);
	# doesn't really matter which one we check (other than $zone); either they're all defined, or none are
	return undef unless defined $year;

	# This block is changed from the original in Date::Parse in the following ways:
	#	*	We're using timegm_modern/timelocal_modern instead of timegm/timelocal.  This fixes all
	#		sorts of gnarly issues, but most especially the heinous RT/53413 / RT/105031 bug.  (Side
	#		note: perhaps Parse::Date could use these as well?  If so, that would close that raft of
	#		bugs and then we wouldn't need to reimplement the guts of `str2time` at all.)
	#	*	The original code set the __DIE__ sig handler to ignore in the `eval`s.  But I'm not
	#		comfortable doing that, and I'm not convinced it's necessary.
	#	*	The original code did a little dance to make sure that a -1 return from timegm/timelocal
	#		was a valid return and not an indication of an error.  But I can't see any indication
	#		that they ever actually return -1 on error, either in the current Time::Local code, or
	#		in its Changes file (e.g. for older versions).  And, since our version of `strptime`
	#		specifically adds 1900 to the year (sometimes) to avoid Time::Local's horrible
	#		"two-digit year" handling, it makes coming up with a value to compare -1 against more of
	#		a PITA.  Plus it's inefficient for what appears to be no real gain.
	my $result;
	if (defined $zone)
	{
		$result = eval { timegm_modern($sec, $min, $hour, $day, $month, $year) };
		return undef unless defined $result;
		$result -= $zone;
	}
	else
	{
		$result = eval { timelocal_modern($sec, $min, $hour, $day, $month, $year) };
		return undef unless defined $result;
	}

	return $result + $subsec;
}

sub _parsedate
{
	require Time::ParseDate;
	my ($time, $zonespec) = @_;
	return scalar Time::ParseDate::parsedate($time, $zonespec eq 'local' ? () : (GMT => 1));
}


#######################
# REGULAR CLASS STUFF #
#######################

sub new
{
	my $class = shift;
	my $zonespec = @_ == 2 || @_ == 7 ? shift : $DEFAULT_ZONE;
	croak("Unrecognized timezone specifier") unless exists $ZONE_FLAG{$zonespec};

	my $t;
	if (@_ == 0)
	{
		$t = time;
	}
	elsif (@_ == 6)
	{
		my ($y, $m, $d, $H, $M, $S) = @_;
		--$m;										# timelocal/timegm will expect month as 0..11
		# but we'll use timelocal_modern/timegm_modern so we don't need to twiddle the year number
		$t = eval {		$zonespec eq 'local'
							? timelocal_modern($S, $M, $H, $d, $m, $y)
							:    timegm_modern($S, $M, $H, $d, $m, $y)
		};
		croak("Illegal datetime: $y/" . ($m + 1) . "/$d $H:$M:$S") unless defined $t;
	}
	elsif (@_ == 1)
	{
		$t = shift;
		if ( my $conv_class = blessed $t )
		{
			if ( $t->isa('Time::Piece') )
			{
				# it's already what we were going to construct anyway;
				# just stick it in a hashref and call it a day
				return bless { impl => $t }, $class;
			}
			else
			{
				croak("Don't know how to convert $conv_class to $class");
			}
		}
	}
	else
	{
		croak("Illegal number of arguments to datetime()");
	}

	bless { impl => scalar Time::Piece->_mktime($t, $ZONE_FLAG{$zonespec}) }, $class;
}


sub is_local {  shift->{impl}->[Time::Piece::c_islocal] }
sub is_gmt   { !shift->{impl}->[Time::Piece::c_islocal] }
*is_utc = \&is_gmt;


sub as
{
	my ($self, $conv_spec) = @_;

	if ( $conv_spec =~ /^(\W)(\w+)$/ )
	{
		my $fmt = join($1, map { "%$_" } split('', $2));
		return $self->strftime($fmt);
	}
	if ( $conv_spec eq 'Time::Piece' )
	{
		return $self->{impl};
	}
	else
	{
		croak("Don't know how to convert " . ref( $self) . " to $conv_spec");
	}
}


# ACCESSORS

sub year		{ shift->{impl}->year }
sub month		{ shift->{impl}->mon }
sub day			{ shift->{impl}->mday }
sub hour		{ shift->{impl}->hour }
sub minute		{ shift->{impl}->min }
sub second		{ shift->{impl}->sec }
sub epoch		{ shift->{impl}->epoch }
sub time_zone	{ shift->{impl}->strftime('%Z') }
sub day_of_week	{ shift->{impl}->day_of_week || 7 }						# change Sunday from 0 to 7
sub day_of_year	{ shift->{impl}->yday + 1 }								# change from 0-based to 1-based
sub quarter		{ int(shift->{impl}->_mon / 3) + 1 }					# calc quarter from (zero-based) month

sub split
{
	my $impl = shift->{impl};
	( $impl->year, $impl->mon, $impl->mday, $impl->hour, $impl->min, $impl->sec )
}


# FORMATTERS

sub strftime	{ shift->{impl}->strftime(@_) }
sub iso8601		{ shift->{impl}->datetime }
*iso = \&iso8601;


########################
# OVERLOADED OPERATORS #
########################

sub _op_convert
{
	my $operand = shift;
	return $operand unless blessed $operand;
	return $operand->{impl} if $operand->isa('Date::Easy::Datetime');
	return $operand if $operand->isa('Time::Piece');
	croak ("don't know how to handle conversion of " . ref $operand);
}

sub _result_convert
{
	my $func = shift;
	return ref($_[0])->new( scalar $func->(_op_convert($_[0]), _op_convert($_[1]), $_[2]) );
}

sub _add_seconds		{ _result_convert( \&Time::Piece::add      => @_ ) }
sub _subtract_seconds	{ _result_convert( \&Time::Piece::subtract => @_ ) }
# subclasses can override these to change what units an integer represents
sub _add_integer		{ $_[0]->add_seconds($_[1])      }
sub _subtract_integer	{ $_[0]->subtract_seconds($_[1]) }

sub _dispatch_add
{
	if ( blessed $_[1] && $_[1]->isa('Date::Easy::Units') )
	{
		$_[1]->_add_to($_[0]);
	}
	else
	{
		# this should DTRT for whichever class we are
		$_[0]->_add_integer($_[1]);
	}
}

sub _dispatch_subtract
{
	if ( blessed $_[1] && $_[1]->isa('Date::Easy::Units') )
	{
		# this shouldn't be possible ...
		die("should have called overloaded - for ::Units") if $_[2];
		# as the name implies, this method assumes reversed operands
		$_[1]->_subtract_from($_[0]);
	}
	elsif ( blessed $_[1] && $_[1]->isa('Date::Easy::Datetime') )
	{
		my ($lhs, $rhs) = $_[2] ? @_[1,0] : @_[0,1];
		my $divisor = $lhs->isa('Date::Easy::Date') && $rhs->isa('Date::Easy::Date') ? 86_400 : 1;
		($lhs->epoch - $rhs->epoch) / $divisor;
	}
	else
	{
		# this should DTRT for whichever class we are
		$_[0]->_subtract_integer($_[1]);
	}
}

use overload
	'""'	=>	sub { Time::Piece::cdate      (_op_convert($_[0])                           ) },
	'<=>'	=>	sub { Time::Piece::compare    (_op_convert($_[0]), _op_convert($_[1]), $_[2]) },
	'cmp'	=>	sub { Time::Piece::str_compare(_op_convert($_[0]), _op_convert($_[1]), $_[2]) },

	'+'		=>	\&_dispatch_add,
	'-'		=>	\&_dispatch_subtract,
;


# MATH METHODS

sub add_seconds			{ shift->_add_seconds      (@_) }
sub add_minutes			{ shift->_add_seconds      ($_[0] * 60)            }
sub add_hours			{ shift->_add_seconds      ($_[0] * 60 * 60)       }
sub add_days			{ shift->_add_seconds      ($_[0] * 60 * 60 * 24)  }
sub add_weeks			{ shift->add_days          ($_[0] * 7)             }
sub add_months			{ ref($_[0])->new( shift->{impl}->add_months(@_) ) }
sub add_years			{ ref($_[0])->new( shift->{impl}->add_years (@_) ) }

sub subtract_seconds	{ shift->_subtract_seconds (@_) }
sub subtract_minutes	{ shift->_subtract_seconds ($_[0] * 60)            }
sub subtract_hours		{ shift->_subtract_seconds ($_[0] * 60 * 60)       }
sub subtract_days		{ shift->_subtract_seconds ($_[0] * 60 * 60 * 24)  }
sub subtract_weeks		{ shift->subtract_days     ($_[0] * 7)             }
sub subtract_months		{ shift->add_months($_[0] * -1)                    }
sub subtract_years		{ shift->add_years ($_[0] * -1)                    }



1;



# ABSTRACT: easy datetime class
# COPYRIGHT

__END__