File Coverage

blib/lib/Date/EzDate.pm

Criterion	Covered	Total	%
statement	487	590	82.5
branch	265	360	73.6
condition	66	104	63.4
subroutine	54	64	84.3
pod	9	15	60.0
total	881	1133	77.7

package Date::EzDate;
use strict;
use Carp;
use vars qw($VERSION @ltimefields $overload $default_warning);

# documentation at end of file

# debugging tools
# use Debug::ShowStuff ':all';


# object overloading
use overload
	'""'     => sub{$_[0]->{'default'}}, # stringification
	'<=>'    => \&compare,               # comparison
	'+'      => \&addition,              # addition
	'-'      => \&subtraction,           # subtraction
	fallback => 1;                       # operations not defined here


# version
$VERSION = '1.14';

# constants and globals
use constant WARN_NONE   => 0;
use constant WARN_STDERR => 1;
use constant WARN_CROAK  => 2;
$default_warning = WARN_STDERR;
$overload = 'epochday';

# psuedo-constants
@ltimefields = 	qw[sec min hour dayofmonth monthnum year weekdaynum yearday dst];


#------------------------------------------------------------------------------
# export
#
use vars qw[@EXPORT_OK %EXPORT_TAGS @ISA];
@ISA = 'Exporter';

@EXPORT_OK = qw[
	date_range_string
	time_range_string
	day_lumps
];

%EXPORT_TAGS = ('all' => [@EXPORT_OK]);
#
# export
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# new
#
sub new {
	my ($class, $init, %opts) = @_;
	my ($rv, %tiehash);

	# if date is an EzDate object
	if ($init && UNIVERSAL::isa($init, 'Date::EzDate'))
		{ return $init->clone }

	# if string doesn't have any content, undef it
	if (
		defined($init) &&
		(! ($init =~ m|\S|s) )
		) {
		undef $init;
	}

	# preprocess full time
	$class->can('preprocess_time_string') and
		defined($init) and
		$init = $class->preprocess_time_string($init);

	tie(%tiehash, $class . '::Tie', $init, %opts) or return undef;

	$rv = bless(\%tiehash, $class);
	$rv->can('after_create') and $rv->after_create();

	return $rv;
}
#
# new
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# clone
#
sub clone {
	my ($self) = @_;
	my $ob = $self->tie_ob;
	my ($rv);

	$rv = ref($self)->new([
		$ob->{'sec'},
		$ob->{'min'},
		$ob->{'hour'},
		$ob->{'dayofmonth'},
		$ob->{'monthnum'},
		$ob->{'year'},
		$ob->{'weekdaynum'},
		$ob->{'yearday'},
		$ob->{'dst'},
		$ob->{'epochsec'}
		]);

	%{$ob->{'formats'}} and
		$rv->tie_ob->{'formats'} = {%{$ob->{'formats'}}};

	return $rv;
}
#
# clone
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# format subs
#
sub set_warnings {return $_[0]->tie_ob->{'warnings'} = $_[1]}
sub zero_hour_ampm {return $_[0]->tie_ob->{'zero_hour_ampm'} = $_[1]}

sub set_format {return $_[0]->tie_ob->set_format(@_[1..$#_])}

sub get_format {
	my ($self, $key) = @_;
	my $ob = $self->tie_ob;
	$key =~ s|\s||gs;
	$key = lc($key);
	return join('', @{$ob->{'formats'}->{$key}});
}

sub del_format {return delete $_[0]->{$_[1]}}
sub tie_ob{return tied(%{$_[0]})}
#
# format subs
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# next_month
#
sub next_month {
	my ($self, $jump) = @_;
	my $ob = $self->tie_ob;
	return $ob->next_month($jump);
}
#
# next_month
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# compare
#
sub compare {
	my ($left, $right) = @_;
	ref($right) or $right = Date::EzDate->new($right);
	$left->{$overload} <=> $right->{$overload};
}
#
# compare
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# addition and subtraction
#
sub addition {
	my ($self, $val) = @_;
	$self->{$overload} += $val;
	return $self;
}

sub subtraction {
	my ($self, $val) = @_;
	$self->{$overload} -= $val;
	return $self;
}
#
# addition and subtraction
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# date_range_string
#
sub date_range_string {
	my ($class, $start, $end);

	# if first argument is a reference, use it as start
	if (UNIVERSAL::isa($_[0], 'Date::EzDate')) {
		($start, $end) = @_;
		$class = ref($start);
	}

	# else this sub is being called statically
	else {
		my (@args);

		# expand array references
		foreach my $arg (@_) {
			if (UNIVERSAL::isa($arg, 'ARRAY'))
				{ push @args, @$arg }
			else
				{ push @args, $arg }
		}

		# if called using a class
		if ( int(@args/2)!=(@args/2) )
			{ ($class, $start, $end) = @args }

		# else called w/o an explicit class
		else {
			$class = 'Date::EzDate';
			($start, $end) = @args;
		}
	}


	# both $start and $end must be defined
	unless ( defined($start) && defined($end) )
		{ croak 'date_range_string requires defined start and end dates' }

	# set as EzDate objects
	ref($start) or $start = $class->new($start);
	ref($end)   or $end   = $class->new($end);

	# rearrange as necessary
	if ($start->{'epoch day'} > $end->{'epoch day'}){
		($start, $end) = ($end, $start);
	}

	# if same year
	if ($start->{'year'} == $end->{'year'}) {
		# if same month
		if ($start->{'monthnum'} == $end->{'monthnum'}) {
			# same day
			if ($start->{'day of month'} == $end->{'day of month'}) {
				return $start->{'{month short} {day of month no zero}, {year}'};
			}

			# else different days
			else {
				my $format = '{day of month no zero}';

				return
					$end->{'month short'} . ' ' .
					$start->{$format} .
					'-' .
					$end->{$format} .
					', ' .
					$end->{'year'};
			}
		}

		# else different months
		else {
			my $format = '{month short} {day of month no zero}';

			return
				$start->{$format} .
				'-' .
				$end->{$format} .
				', ' .
				$end->{'year'};
		}
	}

	# else different years, so do full range
	else {
		my $format = '{month short} {day of month no zero}, {year}';

		return
			$start->{$format} .
			'-' .
			$end->{$format};
	}
}
#
# date_range_string
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# time_range_string
#
sub time_range_string {
	my ($class, $start, $end, $rv);

	# if first argument is a reference, use it as start
	if (ref $_[0]) {
		($start, $end) = @_;
		$class = ref($start);
	}

	# else this sub is being called statically
	else {
		# if called using a class
		if ( int(@_/2)!=(@_/2) )
			{ ($class, $start, $end) = @_ }

		# else called w/o an explicit class
		else {
			$class = 'Date::EzDate';
			($start, $end) = @_;
		}
	}

	# both $start and $end must be defined
	unless ( defined($start) && defined($end) )
		{ croak 'time_range_string requires defined start and end dates' }

	# set as EzDate objects
	ref($start) or $start = $class->new($start);
	ref($end)   or $end   = $class->new($end);

	# rearrange as necessary
	if ($start->{'epochsec'} > $end->{'epochsec'}){
		($start, $end) = ($end, $start);
	}

	$rv = $start->{'ampm hour no zero'} . ':' . $start->{'min'};

	# if same ampm
	if ($start->{'ampm'} ne $end->{'ampm'})
		{ $rv .= $start->{'ampm'} }

	$rv .=
		'-' .
		$end->{'ampm hour no zero'} . ':' . $end->{'min'} .
		$end->{'ampm'};

	return $rv;
}
#
# time_range_string
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# day_lumps
#
sub day_lumps {
	my (@org) = @_;
	my ($class, @rv, $current);
	$class = 'Date::EzDate';

	foreach my $date (@org) {
		ref($date) or $date = $class->new($date);

		if ($current) {
			if ( $date->{'epochday'} == ($current->[1]->{'epochday'} + 1) ) {
				$current->[1] = $date;
			}

			else {
				push @rv, $current;
				$current = [ $date, $date ];
			}
		}

		else {
			$current = [ $date, $date ];
		}
	}

	# add last current
	$current and push @rv, $current;

	return @rv;
}
#
# day_lumps
#------------------------------------------------------------------------------



###############################################################################
# Date::EzDate::Tie
#
package Date::EzDate::Tie;
use strict;
use Carp 'croak', 'carp';
use Tie::Hash;
use Time::Local;
use re 'taint';
use POSIX;

# debugging tools
# use Debug::ShowStuff ':all';

use vars qw(
	@ISA
	%WeekDayNums
	%MonthNums
	@MonthDays
	@MonthLong
	@MonthShort
	@WeekDayLong
	@WeekDayLong
	@WeekDayShort
	@DayOfMonthRd
	%PCodes
	$pcode
	$epoch_offset
	@OrdWords $OrdWordsRx %OrdWordsNums
	@OrdNums $OrdNumsRx
);

@ISA = 'Tie::StdHash';


# globals
@WeekDayShort = qw[Sun Mon Tue Wed Thu Fri Sat];
@WeekDayLong  = qw[Sunday Monday Tuesday Wednesday Thursday Friday Saturday];
@MonthShort   = qw[Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec];
@MonthLong    = qw[January February March April May June July August September October November December];
@MonthDays    = qw[31 x 31 30 31 30 31 31 30 31 30 31];
@WeekDayNums{qw[sun mon tue wed thu fri sat]}=(0..6);
@MonthNums{qw[jan feb mar apr may jun jul aug sep oct nov dec]}=(0..11);


# ordinals
@OrdWords = qw[Zeroth First Second Third Fourth Fifth Sixth Seventh Eighth Ninth
	Tenth Eleventh Twelfth Thirteenth Fourteenth Fifteenth Sixteenth Seventeenth Eighteenth Ninteenth
	Twentieth Twentyfirst Twentysecond Twentythird Twentyfourth Twentyfifth Twentysixth Twentyseventh
	Twentyeighth Twentyninth Thirtieth Thirtyfirst];
$OrdWordsRx = '\b(' . join('|', @OrdWords[1..$#OrdWords]) . ')\b';
foreach my $i (1..$#OrdWords)
	{$OrdWordsNums{lc($OrdWords[$i])} = $i}
@OrdNums = qw[0th 1st 2nd 3rd 4th 5th 6th 7th 8th 9th
	10th 11th 12th 13th 14th 15th 16th 17th 18th 19th
	20th 21st 22nd 23rd 24th 25th 26th 27th
	28th 29th 30th 31st];

# percent code regex
$pcode = '^\%[\w\%]$';

%PCodes = qw[
	yearlong         year
	yearshort        yeartwodigits
	month            monthlong
	weekday          weekdayshort
	dayofyear        yearday
	dayofyearbase1   yeardaybase1
	%Y               year
	%y               yeartwodigits
	%a               weekdayshort
	%A               weekdaylong
	%d               dayofmonth
	%D               %m/%d/%y
	%H               hour
	%h               monthshort
	%b               ampmhournozero
	%B               hournozero
	%e               monthnumbase1nozero
	%f               dayofmonthnozero
	%j               yeardaybase1
	%k               ampmhour
	%m               monthnumbase1
	%M               min
	%P               ampmuc
	%p               ampmlc
	%s               epochsec
	%S               sec
	%w               weekdaynum
	%y               yeartwodigits
	%T               %H:%M:%S
	%n               newline
	%t               tab
	%%               percent
	];
$PCodes{'%c'} = '{weekdayshort} %h %d %H:%M:%S %Y';
$PCodes{'%r'} = '%k:%M:%S %P';


# constants
use constant t_60        => 60;
use constant t_60_60     => 3600;
use constant t_60_60_24  =>  86400;
use constant WARN_NONE   => Date::EzDate::WARN_NONE;
use constant WARN_STDERR => Date::EzDate::WARN_STDERR;
use constant WARN_CROAK  => Date::EzDate::WARN_CROAK;

use constant DST_ADJUST_NO  => 0;
use constant DST_ADJUST_YES => 1;


#------------------------------------------------------------------------------
# TIEHASH
#
sub TIEHASH {
	my ($class, $time, %opts)=@_;
	my $self = bless ({}, $class);

	# TESTING
	# println '$class->TIEHASH(', $time, ')';
	# my $indent = indent();

	# set some non-date properties
	$self->{'zero_hour_ampm'} = defined($opts{'zero_hour_ampm'}) ? $opts{'zero_hour_ampm'} : 1;
	$self->{'formats'} = {};
	$self->{'settings'} = {'dst_kludge' => 1};

	# default builtin formats
	$self->set_format('fullday',    '{month short} {day of month no zero}, {year}');
	$self->set_format('fulldate',   '{fullday}');
	$self->set_format('dayandtime', '{month short} {day of month}, {year} {ampmhour no zero}:{minute}{ampm}');
	$self->set_format('default',    '{dayandtime}');


	# if clone
	if (ref $time){
		if (! UNIVERSAL::isa($time, 'ARRAY') )
			{ croak '$time is not an array' }

		@{$self}{@Date::EzDate::ltimefields, 'epochsec'}=@{$time};
	}

	else {
		# calculate and set properties of current time
		# set time from timefromfull
		$self->setfromtime(DST_ADJUST_NO, time());

		if (defined $time) {
			$time = $self->timefromfull($time);

			defined($time) or return undef;

			$self->setfromtime(DST_ADJUST_NO, $time);
		}
	}

	return  $self;
}
#
# TIEHASH
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# setfromtime
#
sub setfromtime {
	my ($self, $dst_adjust, $time) = @_;
	my ($dst_before, @timevals);
	$self->{'settings'}->{'dst_kludge'} or $dst_adjust = 0;

	# TESTING
	# println '$self->setfromtime';
	# my $indent = indent();
	# println '$dst_adjust: ', $dst_adjust;
	# println '$time: ', $time;

	# if we should adjust the hour if necessary
	if ($dst_adjust)
		{ $dst_before = $self->{'dst'} }

	# set current epoch second
	$self->{'epochsec'} = $time;

	# get current time values
	@timevals = localtime($time);

	if (! @timevals)
		{ croak "cannot: get localtime values from this epoch value: $time" }

	@{$self}{@Date::EzDate::ltimefields} = @timevals;

	if (
		$dst_adjust &&
		defined($dst_before) &&
		($dst_before != $self->{'dst'})
		) {

		if ($dst_before)
			{ $self->{'epochsec'} += t_60_60 }
		else
			{ $self->{'epochsec'} -= t_60_60 }

		@{$self}{@Date::EzDate::ltimefields}=localtime($self->{'epochsec'});
	}

	$self->{'year'} += 1900;
}
#
# setfromtime
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# set_format
#
sub set_format {
	my ($self, $name, $format) = @_;

	# normalize name
	$name =~ s|\s||g;
	$name =~ tr/A-Z/a-z/;

	$self->{'formats'}->{$name} = format_split($format);
}

sub format_split {
	my @rv = split(m/(\{[^\{\}]*\}|\%.)/, $_[0]);

	foreach my $el (@rv) {
		if ($el =~ m|^\{.*\}$|s)
			{normalize_key($el)}
	}

	return \@rv;
}
#
# set_format
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# warn
#
sub warn {
	my $self = shift;
	my $level = defined($self->{'warnings'}) ? $self->{'warnings'} : $Date::EzDate::default_warning;

	$level or return undef;

	if ($level == WARN_STDERR) {
		carp 'WARNING: ', @_;
		return undef;
	}

	croak @_;
}
#
# warn
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# normalize_key
#
sub normalize_key {
	$_[0] =~ s|\s||gs;
	$_[0] =~ tr/A-Z/a-z/ unless $_[0] =~ m|^\%\w$|;
	$_[0] =~ s|ordinal|ord|sg;

	$_[0] =~ s|hours|hour|sg;
	# $_[0] =~ s|days\b|day|sg;

	$_[0] =~ s|minute|min|sg;
	$_[0] =~ s|mins|min|sg;

	$_[0] =~ s|second|sec|sg;
	$_[0] =~ s|secs|sec|sg;

	$_[0] =~ s|number|num|sg;
}
#
# normalize_key
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# next_month
#
sub next_month {
	my ($self, $jumps) = @_;
	return $self->STORE('monthnum', $self->{'monthnum'} + $jumps);
}
#
# next_month
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# STORE
#
sub STORE {
	my ($self, $key, $val) = @_;
	my $orgkey = $key;
	my $orgval = $val;

	# error checking
	if (! defined $val)
		{return $self->warn('Must send a defined value when setting a property of an EzDate object')}

	# if value contains {, assume they're assigning a format
	$val =~ m|[\{\%]| and return $self->set_format($key, $val);

	# clean a little
	normalize_key($key);

	# get key from aliases if necessary
	$key = $self->get_alias($key, 'strip_no_zero'=>1);


	# dayofmonth, weekdaynum, yearday
	if ($key =~ m/^(dayofmonth|weekdaynum|dayofweeknum|yearday)$/s) {
		# warn if setting day of month greater than month has days
		if (
			($key eq 'dayofmonth') &&
			($val > daysinmonth($self->{'monthnum'}, $self->{'year'}))
			) {
			$self->warn(
				"setting day of month ($val) to higher than days in month (",
				daysinmonth($self->{'monthnum'}, $self->{'year'}),
				')',
			);
		}

		$self->setfromtime(
			DST_ADJUST_YES,
			$self->{'epochsec'} - ($self->{$key} * t_60_60_24) + ($val * t_60_60_24)
		);
	}

	elsif ($key eq 'sec')
		{$self->setfromtime(DST_ADJUST_NO, $self->{'epochsec'} - $self->{'sec'} + $val)}

	elsif ($key eq 'min') {
		$self->setfromtime(
			DST_ADJUST_NO,
			$self->{'epochsec'} - ($self->{'min'} * 60) + ($val * 60)
		)
	}

	elsif ($key eq 'minofday') {
		$self->setfromtime (
			DST_ADJUST_NO,
			$self->{'epochsec'} - ($self->{'hour'} * t_60_60)  - ($self->{'min'} * 60) + ($val * 60)
		)
	}

	elsif ($key eq 'hour') {
		$val = timelocal(
			$self->{'sec'},
			$self->{'min'},
			$val,
			$self->{'dayofmonth'},
			$self->{'monthnum'},
			$self->{'year'},
		);

		$self->setfromtime(DST_ADJUST_NO, $val);
	}

	# hour and minute
	elsif ( ($key eq 'clocktime') || ($key =~ m|^mil(itary)?time$|) ) {
		my ($changed, $hour, $min, $sec) = $self->gettime($val);

		unless (defined $hour)
			{$hour = $self->{'hour'}}
		unless (defined $min)
			{$min = $self->{'min'}}
		unless (defined $sec)
			{$sec = $self->{'sec'}}

		$self->setfromtime
			(
			0,
			$self->{'epochsec'}

			- ($self->{'sec'})
			- ($self->{'min'} * 60)
			- ($self->{'hour'} * t_60_60)

			+ ($sec)
			+ ($min * 60)
			+ ($hour * t_60_60)
			);
	}

	elsif ($key eq 'ampmhour') {
		if ($self->{'hour'} >= 12)
				{$val += 12}
		$self->STORE('hour', $val);
	}

	elsif (
		($key eq 'ampm') ||
		($key eq 'ampmlc') ||
		($key eq 'ampmuc')
		) {
		my ($multiplier);

		if (length($val) == 1)
			{$val .= 'm'}
		$val = lc($val);

		# error checking
		unless ( ($val eq 'am') || ($val eq 'pm') )
			{return $self->warn('ampm may only be set to am or pm')}

		# if no change, we're done
		if ($self->{'hour'} < 12) {
			if ($val eq 'am') {return}
		}
		else {
			if ($val eq 'pm') {return}
		}

		if ($val eq 'am')
			{$multiplier = -1}
		else
			{$multiplier = 1}

		$self->setfromtime(DST_ADJUST_YES, $self->{'epochsec'} + (12 * t_60_60 * $multiplier) );
	}

	elsif ($key eq 'dst')
		{return $self->warn('dst property is read-only')}

	elsif ($key eq 'epochsec')
		{$self->setfromtime(DST_ADJUST_NO, $val)}

	elsif ($key eq 'epochmin')
		{$self->setfromtime(DST_ADJUST_NO, $self->{'epochsec'} - ($self->getepochmin * 60) + ($val * 60) )}

	elsif ($key eq 'epochhour')
		{$self->setfromtime(DST_ADJUST_NO, $self->{'epochsec'} - ($self->getepochhour * t_60_60) + ($val * t_60_60) )}

	elsif ($key eq 'epochday') {
		my ($oldhour, $oldepochsec, $oldmin);

		$self->setfromtime(
			DST_ADJUST_YES,
			$self->{'epochsec'} - ($self->getepochday * t_60_60_24) + (int($val) * t_60_60_24)
		);
	}

	# ordinals
	elsif ($key =~ m/dayofmonthord(word|num)?/) {
		# if numeric
		if ($val =~ s|^(\d+)\s*\w*$|$1|s)
			{$self->STORE('dayofmonth', $val)}

		# else word
		else {
			my $nval = $val;
			$nval =~ tr/A-Z/a-z/;
			$nval =~ s|\W||gs;

			# if no such ordinal exists
			unless ($nval = $OrdWordsNums{$nval})
				{return $self->warn("Invalid ordinal: $val")}

			$self->STORE('dayofmonth', $nval);
		}
	}

	elsif ($key eq 'year') {
		my ($maxday, $targetday);

		# if same year, nothing to do
		if ($self->{'year'} == $val)
			{return}

		# make sure day of month isn't greater than maximum day of target month
		$maxday = daysinmonth($self->{'monthnum'}, $val);

		if ($self->{'dayofmonth'} > $maxday) {
			$self->warn(
				"Changing the year sets day of month ($self->{'dayofmonth'}) to higher than days in month ($maxday); ",
				"setting the day down to $maxday"
				);
			$targetday = $maxday;
		}
		else
			{$targetday = $self->{'dayofmonth'}}

		$val = timelocal($self->{'sec'}, $self->{'min'}, $self->{'hour'}, $targetday, $self->{'monthnum'}, $val);
		$self->setfromtime(DST_ADJUST_YES, $val);
	}

	elsif ($key =~ m/^year(two|2)digit/) {
		$val =~ s|^.*(..)$|$1|;
		$self->STORE('year', substr($self->{'year'}, 0, 2) . zeropad_2($val));
	}

	elsif ($key =~ m/^monthnumbase(one|1)/)
		{$self->STORE('monthnum', $val - 1)}


	#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
	# monthnum
	#
	elsif ($key eq 'monthnum') {
		my ($target, $epoch_second);
		my $month = $self->{'monthnum'};
		my $year = $self->{'year'};
		my $orgday = $self->{'dayofmonth'};
		my $dayofmonth = $self->{'dayofmonth'};
		my $jumps = $val - $month;

		# if nothing to do
		$jumps or return;

		$target = $jumps;
		$target = abs($target);

		# jumping forward
		if ($jumps > 0) {
			foreach (1..$target) {
				# if end of year
				if ($month == 11) {
					$month = 0;
					$year++;
				}
				else
					{$month++}
			}
		}

		# jumping backward
		else {
			foreach (1..$target) {
				# if beginning of year
				if ($month == 0) {
					$month = 11;
					$year--;
				}
				else
					{$month--}
			}
		}


		# adjust day for shorter month (if necessary)
		if ($dayofmonth > 28) {
			my $dim = daysinmonth($month, $year);

			if ($dim < $dayofmonth)
				{ $dayofmonth = $dim }
		}

		# get epoch second from timelocal
		$epoch_second = timelocal($self->{'sec'}, $self->{'min'}, $self->{'hour'}, $dayofmonth, $month, $year);
		$self->setfromtime(DST_ADJUST_NO, $epoch_second);
	}
	#
	# monthnum
	#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -


	elsif ( ($key eq 'monthshort') || ($key eq 'monthlong') )
		{$self->STORE('monthnum', $MonthNums{lc(substr($val, 0, 3))})}

	elsif (
		($key eq 'weekdayshort') ||
		($key eq 'weekdaylong') ||
		($key eq 'dayofweekshort') ||
		($key eq 'dayofweeklong')
		) {
		$self->STORE(
			'weekdaynum',
			$WeekDayNums{lc(substr($val, 0, 3))})
	}

	# year day
	elsif ($key =~ m/^yeardaybase(one|1)$/)
		{$self->STORE('yearday', $val - 1)}

	# default, full, dmy
	elsif ( ($key eq 'default') || ($key eq 'full') || ($key eq 'dayandtime') || ($key eq 'dmy') ){
			my (%opts);

			if ( $key eq 'dmy')
				{$opts{'dateonly'} = 1}

			$self->setfromtime(DST_ADJUST_YES, $self->timefromfull($val, %opts));
		}

	else
		{return $self->warn("Do not understand key: $orgkey")}
}
#
# STORE
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# FETCH
#
sub FETCH {
	my ($self, $key, %opts) = @_;
	my $orgkey = $key;

	# get key from aliases if necessary
	$key = $self->get_alias($key);


	#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
	# nested properties
	#
	if ( (! ref $key) && ($key =~ m|[\{\%]|) && ($key !~ m|$pcode|o) )
		{$key = format_split($key)}

	if (ref $key) {
		my @rv = @$key;

		foreach my $el (@rv) {
			# if this is one of the format elements
			# then fetch the value of the given key
			if (
				($el =~ s|\{([^\}]+)\}|$1|) ||  # if it is enclosed in {}
				($el =~ m|$pcode|o)             # if it is a %x code
				) {
				$el =~ s|['"\s]||g;
				$el = $self->FETCH($el, normalized=>1);
			}
		}

		return join('', @rv);
	}
	#
	# nested properties
	#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -


	# clean up key
	$opts{'normalized'} or normalize_key($key);


	# already or mostly calculated
	if (exists $self->{$key}) {
		if ($key =~ m/^(dayofmonth|monthnum|hour|min|sec)$/)
			{return zeropad_2($self->{$key})}

		return $self->{$key};
	}

	# nozero's
	if ($key =~ s/no(zero|0)//)
		{return $self->FETCH($key) + 0}

	# day of month ord
	if ($key =~ m|^dayofmonthord(word)?$|)
		{return $OrdWords[$self->{'dayofmonth'}]}
	if ($key eq 'dayofmonthordnum')
		{return $OrdNums[$self->{'dayofmonth'}]}

	# weekday
	if ($key =~ m/^(weekdayshort|dayofweekshort|dayofweek)$/)
		{return $WeekDayShort[$self->{'weekdaynum'}]}
	if ($key =~ m/^(weekdaylong|dayofweeklong)$/)
		{return $WeekDayLong[$self->{'weekdaynum'}]}
	if ($key eq 'dayofweeknum')
		{return $self->{'weekdaynum'}}

	# month
	if ($key eq 'monthshort') {
		defined($self->{'monthnum'}) or die 'undefined monthnum';
		return $MonthShort[$self->{'monthnum'}];
	}

	if ($key eq 'monthlong')
		{ return $MonthLong[$self->{'monthnum'}] }
	if ($key =~ m/^monthnumbase(one|1)/)
		{ return zeropad_2($self->{'monthnum'} + 1) }

	if ($key =~ m/^yeardaybase(one|1)/)
		{ return zeropad_open($self->{'yearday'} + 1, 3) }

	# year
	if ($key =~ m/^yeartwodigit/)
		{ return substr($self->{'year'}, 2) }

	# epochs
	if ($key eq 'epochmin')
		{ return $self->getepochmin }
	if ($key eq 'epochhour')
		{ return $self->getepochhour }
	if ($key eq 'epochday')
		{ return $self->getepochday }

	# leapyear
	if ($key =~ m/^(is)?leapyear/)
		{return isleapyear($self->{'year'})}

	# days in month
	if ($key eq 'daysinmonth')
		{return daysinmonth($self->{'monthnum'}, $self->{'year'}) }

	# DMY: eg 15JAN2001
	if ($key eq 'dmy')
		{return zeropad_2($self->{'dayofmonth'}) . uc($MonthShort[$self->{'monthnum'}]) . $self->{'year'} }

	# full
	if ($key eq 'full') {
		return
			$WeekDayShort[$self->{'weekdaynum'}]   .  ' ' .
			$MonthShort[$self->{'monthnum'}]       .  ' ' .
			$self->{'dayofmonth'}                  .  ', ' .
			$self->{'year'}                        .  ' ' .
			zeropad_2($self->{'hour'})               .  ':' .
			zeropad_2($self->{'min'})                .  ':' .
			zeropad_2($self->{'sec'});
	}

	# dayparam: A convenient string for passing as a parameter.  Consists
	# of just alphanumerics, is easily human readable, and is completely unambiguous.
	if ($key eq 'dayparam') {
		return
			zeropad_2($self->{'dayofmonth'}) .
			lc($MonthShort[$self->{'monthnum'}]) .
			$self->{'year'};
	}

	# military time, aka "miltime"
	if ($key =~ m|^mil(itary)?time$|)
		{return zeropad_2($self->{'hour'}) . zeropad_2($self->{'min'}) }

	# iso8601
	if ($key eq 'iso8601') {
		return
			$self->{'year'}                   .  '-' .
			zeropad_2($self->{'monthnum'}+1)  .  '-' .
			zeropad_2($self->{'dayofmonth'})  .  ' ' .

			zeropad_2($self->{'hour'})        .  ':' .
			zeropad_2($self->{'min'})         .  ':' .
			zeropad_2($self->{'sec'});
	}

	# minuteofday, aka minofday
	if ($key eq 'minofday')
		{return $self->{'min'} + ($self->{'hour'} * 60) }

	# variable
	my ($ampm);

	# calculate ampm, which is needed in most results from here down
	$ampm = ($self->{'hour'} >= 12) ? 'pm' : 'am';

	# am/pm
	if ( ($key eq 'ampm') || ($key eq 'ampmlc') )
		{return $ampm}

	# AM/PM	uppercase
	if ($key eq 'ampmuc')
		{return uc($ampm)}

	# variable
	my ($ampmhour);

	# calculate ampmhour, which is needed from here down
	if ( ($self->{'hour'} == 0) || ($self->{'hour'} == 12) )
		{$ampmhour = 12}
	elsif ($self->{'hour'} > 12)
		{$ampmhour = $self->{'hour'} - 12}
	else
		{$ampmhour = $self->{'hour'}}

	# am/pm hour
	if ($key eq 'ampmhour')
		{return zeropad_2($ampmhour)}

	# hour and minute with ampm
	if (
		($key eq 'clocktime') ||
		($key eq 'clocktimestrict')
		) {
		my $minofday = $self->FETCH('minofday');

		if ($key eq 'clocktime') {
			if ($minofday == 0)
				{return 'midnight'}
			if ($minofday == 12 * t_60)
				{return 'noon'}
		}

		return
			$self->FETCH('ampmhournozero') .
			':' . zeropad_2($self->{'min'}) . ' ' .
			$ampm;
	}

	# character codes
	$key eq 'newline' && return "\n";
	$key eq 'tab' && return "\t";
	$key eq 'leftbrace' && return '{';
	$key eq 'rightbrace' && return '}';
	$key eq 'percent' && return '%';

	# else we don't know what property is needed
	return $self->warn("do not know this format: $orgkey");
}
#
# FETCH
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# DELETE
#
sub DELETE {
	my ($self, $key) = @_;

	$key =~ s|\s||gs;
	$key = lc($key);

	return delete $self->{'formats'}->{$key};
}
#
# DELETE
#------------------------------------------------------------------------------


sub del_format {return delete $_[0]->tie_ob->{'formats'}->{$_[1]}}


#------------------------------------------------------------------------------
# isleapyear
#
sub isleapyear {
	my ($year) = @_;

	return 1 if ( ($year % 4 == 0) && ( ($year % 100) || ($year % 400 == 0) ) );
	return 0;
}
#
# isleapyear
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# get_alias
#
sub get_alias {
	my ($self, $key, %opts) = @_;

	# normalize
	unless ($key =~ m|[\{\%]|) {
		$key =~ s|\s||g;
		$key = lc($key);

		# strip "nozero" if that option was sent
		$opts{'strip_no_zero'} and $key =~ s|nozero||g;
	}

	# if this has an alias
	if (exists $PCodes{$key})
		{return $self->get_alias($PCodes{$key}, %opts)}

	# if this is a named format
	if (exists $self->{'formats'}->{$key})
		{return $self->{'formats'}->{$key}}

	return $key;
}
#
# get_alias
#------------------------------------------------------------------------------



#------------------------------------------------------------------------------
# getepochday
#
sub getepochday {
	my ($self, $epochsec) = @_;

	# TESTING
	# println '$date->getepochday';
	# my $indent = indent();

	# get epochsecond of date object
	defined($epochsec) or $epochsec = $self->{'epochsec'};

	# calculate $epoch_offset
	# $epoch_offset represents the number of seconds
	# into the epoch day that the actual epoch moment occurs
	unless (defined $epoch_offset) {
		my %date;
		@date{@Date::EzDate::ltimefields} = localtime(0);
		$epoch_offset =
			( ($date{'hour'} * t_60_60) + ($date{'min'} * 60) + $date{'sec'});
	}

	# TESTING
	# println '$epochsec: ', $epochsec;
	# println '$epoch_offset: ', $epoch_offset;

	# return
	return floor( ($epochsec + $epoch_offset) / t_60_60_24);
}
#
# getepochday
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# getepochhour, getepochmin
#
sub getepochhour {
	my ($self) = @_;
	return int($self->{'epochsec'} / t_60_60);
}

sub getepochmin {
	my ($self) = @_;
	return int($self->{'epochsec'} / 60);
}
#
# getepochhour, getepochmin
#------------------------------------------------------------------------------



#------------------------------------------------------------------------------
# daysinmonth
#
sub daysinmonth {
	my ($monthnum, $year) = @_;

	if ($monthnum != 1)
		{return $MonthDays[$monthnum]}
	if (isleapyear($year))
		{return 29}
	return 28;
}
#
# daysinmonth
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# timefromfull
#
sub timefromfull {
	my ($self, $val, %opts) = @_;
	my ($hour, $min, $sec, $day, $month, $year, $rv);
	my $orgval = $val;

	# error checking
	if (! defined $val)
		{return $self->warn("did not get a time string")}

	# quick return: if they just put in an integer
	if ($val =~ m/^\d+$/)
		{return $val}


	# alias hour am/pm to hour:00 am/pm
	# $self->{'zero_hour_ampm'} and $val =~ s/(^|[^:\d])(\d+)\s*([ap]m)/$1$2:00:00 $3/gis;
	$self->{'zero_hour_ampm'} and $val =~ s/(^|[^:\d])(\d+)\s*([ap]m?\b)/$1$2:00:00 $3/gis;

	# special case: ##:##.#####
	# In some time formats, the hour, min, second is
	# followed by fractional seconds.  We don't handle those
	# fractions, so we'll just remove them.
	$val =~ s/(\d+\:\d+)\.[\d\-]+/$1/g;


	# Another special case: A.M. to AM and P.M. to PM
	$val =~ s/a\.m\b/am/gis;
	$val =~ s/p\.m\b/pm/gis;

	# normalize
	$val =~ tr/A-Z/a-z/;
	$val =~ s/[^\w:]/ /g;
	$val =~ s/\s*:\s*/:/g;

	# change ordinals to numbers
	$val =~ s|$OrdWordsRx|$OrdWordsNums{$1}|gis;
	$val =~ s/(\d)(th|rd|st|nd)\b/$1/gis;


	# noon to 12:00:00
	# midnight to 00:00:00
	$val =~ s/\bnoon\b/ 12:00:00 /gis;
	$val =~ s/\bmidnight\b/ 00:00:00 /gis;

	# normalize some more
	$val =~ s/(\d)([a-z])/$1 $2/g;
	$val =~ s/([a-z])(\d)/$1 $2/g;
	$val =~ s/\s+/ /g;
	$val =~ s/^\s*//;
	$val =~ s/\s*$//;


	# today, tomorrow, and yesterday
	if ( ($val eq 'today') || ($val eq 'now') )
		{return time()}
	if ($val eq 'tomorrow')
		{return time() + t_60_60_24}
	if ($val eq 'yesterday')
		{return time() - t_60_60_24}

	# normalize further
	$val =~ s/([a-z]{3})[a-z]+/$1/gs;

	# remove weekday
	$val =~ s/((sun)|(mon)|(tue)|(wed)|(thu)|(fri)|(sat))\s*//;
	$val =~ s/\s*$//;


	# attempt to get time
	unless ($opts{'dateonly'}) {
		($val, $hour, $min, $sec) = $self->gettime($val, 'skipjustdigits'=>1);
	}

	# attempt to get date
	unless ($opts{'timeonly'}) {
		if (length $val)
			{($val, $day, $month, $year) = getdate($val)}
	}

	# trim
	$val =~ s/^\s*//;

	# attempt to get time again
	unless ($opts{'dateonly'}) {
		if (length($val) && (! defined($hour)) ) {
			($val, $hour, $min, $sec) = $self->gettime($val, 'skipjustdigits'=>1, 'croakonfail'=>1);
		}
	}


	if (defined($val) && length($val))
		{return $self->warn("Did not recognize date/time pattern ($val): $orgval")}

	# if we didn't get a day, hour, year, or month we didn't recognize the pattern
	unless (
		defined($hour)   ||
		defined($day)    ||
		defined($month)  ||
		defined($year)
		)
		{return undef}


	# default everything that isn't defined
	unless (defined $hour)
		{$hour = $self->{'hour'}}
	unless (defined $min)
		{$min = $self->{'min'}}
	unless (defined $sec)
		{$sec = $self->{'sec'}}

	unless (defined $month)
		{$month = $self->{'monthnum'}}
	unless (defined $year)
		{$year = $self->{'year'}}
	unless (defined $day)
		{$day = maxday($self->{'dayofmonth'}, $month, $year)}

	# set year to four digits
	if (length($year) == 2)
		{$year = substr($self->{'year'}, 0, 2) . $year}


	# BUG: this is where ezdate crashes on out-of-bounds dates
	eval {
		$rv = timelocal($sec, $min, $hour, $day, $month, $year);
	};


	if (! defined $rv)
		{ $self->warn("Do not recognize date format: $orgval") }

	return $rv;

	# get date sub
	# attempt to get date
	# supported date formats
	# 14 Jan 2001
	# 14 JAN 01
	# 14JAN2001
	# Jan 14, 2001
	# Jan 14, 01
	# 01-14-01
	# 1-14-01
	# 1-7-01
	# 01-14-2001
	sub getdate {
		my ($val, $day, $month, $year) = @_;

		# Tue Jun 12 13:03:28 2012
		if ($val =~ s/^([a-z]+) (\d+) (\S+) (\d+)$/$3/) {
			$year  = $4;
			$month = $MonthNums{$1};
			$day   = $2;
		}

		# 14 Jan 2001
		# 14 JAN 01
		# 14JAN2001   # will be normalized to have spaces
		elsif ($val =~ s/^(\d+) ([a-z]+) (\d+)//) {
			$day = $1;
			$month = $MonthNums{$2};
			$year = $3;
		}

		# Jan 14, 2001
		# Jan 14, 01
		elsif ($val =~ s/^([a-z]+) (\d+) (\d+)//) {
			$month = $MonthNums{$1};
			$day = $2;
			$year = $3;
		}

		# Jan 2001
		# Jan 01
		elsif ($val =~ s/^([a-z]+) (\d+)//) {
			$month = $MonthNums{$1};
			$year = $2;
		}

		# 2001-01-14
		elsif ($val =~ s/^(\d{4}) (\d+) (\d+)//) {
			$year  = $1;
			$month = $2 - 1;
			$day   = $3;
		}

		# 01-14-01
		# 1-14-01
		# 1-7-01
		# 01-14-2001
		elsif ($val =~ s/^(\d+) (\d+) (\d+)//) {
			$month = $1 - 1;
			$day = $2;
			$year = $3;
		}

		return ($val, $day, $month, $year);
	}

	sub ampmhour {
		my ($hour, $ampm)=@_;

		# if 12
		if ($hour == 12) {
			# if am, set to 0
			if ($ampm =~ m/^a/)
				{$hour = 0}
		}

		# else if pm, add 12
		elsif ($ampm =~ m/^p/)
			{$hour += 12}
		return $hour;
	}
}
#
# timefromfull
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# gettime
#
# supported time formats:
#   5pm
#   5:34 pm
#   17:34
#   17:34:13
#   5:34:13
#   5:34:13 pm
#   2330 (military time)
#
sub gettime {
	my ($self, $str, %opts)= @_;
	my ($hour, $min, $sec);

	# clean up a little
	$str =~ s/^://;
	$str =~ s/:$//;
	$str =~ s/(\d)(am|pm)/$1 $2/;


	# 5:34:13 pm
	# 5:34:13 p
	if ($str =~ s/^(\d+):(\d+):(\d+) (a|p)(m|\b)\s*//) {

		$hour = ampmhour($1, $4);
		$min = $2;
		$sec = $3;
	}

	# 17:34:13
	elsif ($str =~ s/^(\d+):(\d+):(\d+)\s*//) {
		$hour = $1;
		$min = $2;
		$sec = $3;
	}

	# 5:34 pm
	elsif ($str =~ s/^(\d+):(\d+) (a|p)m?\s*//) {
		$hour = ampmhour($1, $3);
		$min = $2;
	}

	# 17:34
	elsif ($str =~ s/^(\d+):(\d+)\s*//) {
		$hour = $1;
		$min = $2;
	}

	# 5 pm
	elsif ($str =~ s/^(\d+) (a|p)m?\b\s*//)
		{$hour = ampmhour($1, $2)}

	# elsif just digits
	elsif ( (! $opts{'skipjustdigits'}) && ($str =~ m/^\d+$/) ) {
		$str = zeropad_open($str, 4);
		$hour = substr($str, 0, 2);
		$min = substr($str, 2, 2);
	}

	# else don't recognize format
	elsif ($opts{'croakonfail'})
		{return $self->warn("don't recognize time format: $str")}

	return ($str, $hour, $min, $sec);
}
#
# gettime
#------------------------------------------------------------------------------



#------------------------------------------------------------------------------
# maxday
#
# if the input day is too high for given months,
# returns the highest possible day for that month,
# otherwise returns the input day
#
sub maxday {
	my ($day, $month, $year) = @_;
	my $maxday = daysinmonth($month, $year);

	$day > $maxday and return $maxday;
	return $day;
}
#
# maxday
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# zeropad_open, zeropad_2
#
sub zeropad_open {
	my ($rv, $length) = @_;
	$length ||= 2;
	# return ('0' x ($length - length($rv))) . $rv;
	return sprintf "%0${length}d", $rv;
}

sub zeropad_2 {
	return sprintf "%02d", $_[0];
}
#
# zeropad_open, zeropad_2
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# clone
#
sub clone {
	my ($ob) = @_;

	return ref($ob)->TIEHASH([
		$ob->{'sec'},
		$ob->{'min'},
		$ob->{'hour'},
		$ob->{'dayofmonth'},
		$ob->{'monthnum'},
		$ob->{'year'},
		$ob->{'weekdaynum'},
		$ob->{'yearday'},
		$ob->{'dst'},
		$ob->{'epochsec'}
		]);
}
#
# clone
#------------------------------------------------------------------------------


#
# Date::EzDate::Tie
###############################################################################


# return true
1;
__END__