Time::ParseDate - date parsing both relative and absolute

	use Time::ParseDate;
	$seconds_since_jan1_1970 = parsedate("12/11/94 2pm", NO_RELATIVE => 1)
	$seconds_since_jan1_1970 = parsedate("12/11/94 2pm", %options)

	FUZZY	-> it's okay not to parse the entire date string
	NOW	-> the "current" time for relative times (defaults to time())
	ZONE	-> local timezone (defaults to $ENV{TZ})
	WHOLE	-> the whole input string must be parsed
	GMT	-> input time is assumed to be GMT, not localtime
	UK	-> prefer UK style dates (dd/mm over mm/dd)
	DATE_REQUIRED -> do not default the date
	TIME_REQUIRED -> do not default the time
	NO_RELATIVE -> input time is not relative to NOW
	TIMEFIRST -> try parsing time before date [not default]
	PREFER_PAST -> when year or day of week is ambigueous, assume past
	PREFER_FUTURE -> when year or day of week is ambigueous, assume future
	SUBSECOND -> parse fraction seconds
	VALIDATE -> only accept normal values for HHMMSS, YYMMDD.  Otherwise
		days like -1 might give the last day of the previous month.

	Dow, dd Mon yy
	Dow, dd Mon yyyy
	Dow, dd Mon
	dd Mon yy
	dd Mon yyyy
	Month day{st,nd,rd,th}, year
	Month day{st,nd,rd,th}
	Mon dd yyyy
	yyyy/mm/dd
	yyyy-mm-dd	(usually the best date specification syntax)
	yyyy/mm
	mm/dd/yy
	mm/dd/yyyy
	mm/yy
	yy/mm      (only if year > 12, or > 31 if UK)
	yy/mm/dd   (only if year > 12 and day < 32, or year > 31 if UK)
	dd/mm/yy   (only if UK, or an invalid mm/dd/yy or yy/mm/dd)
	dd/mm/yyyy (only if UK, or an invalid mm/dd/yyyy)
	dd/mm      (only if UK, or an invalid mm/dd)

	count "days"
	count "weeks"
	count "months"
	count "years"
	Dow "after next"
	Dow "before last"
	Dow 			(requires PREFER_PAST or PREFER_FUTURE)
	"next" Dow
	"tomorrow"
	"today"
	"yesterday"
	"last" dow
	"last week"
	"now"
	"now" "+" count units
	"now" "-" count units
	"+" count units		
	"-" count units
	count units "ago"

	hh:mm:ss[.ddd] 
	hh:mm 
	hh:mm[AP]M
	hh[AP]M
	hhmmss[[AP]M] 
	"noon"
	"midnight"

	count "minutes"		(count can be franctional "1.5" or "1 1/2")
	count "seconds"
	count "hours"
	"+" count units
	"+" count
	"-" count units
	"-" count
	count units "ago"

	[+-]dddd
	GMT[+-]d+
	[+-]dddd (TZN)
	TZN

	[ d]d/Mon/yyyy:hh:mm:ss [[+-]dddd]
	yy/mm/dd.hh:mm

	$seconds = parsedate("Mon Jan  2 04:24:27 1995");
	$seconds = parsedate("Tue Apr 4 00:22:12 PDT 1995");
	$seconds = parsedate("04.04.95 00:22", ZONE => PDT);
	$seconds = parsedate("Jan 1 1999 11:23:34.578", SUBSECOND => 1);
	$seconds = parsedate("122212 950404", ZONE => PDT, TIMEFIRST => 1);
	$seconds = parsedate("+3 secs", NOW => 796978800);
	$seconds = parsedate("2 months", NOW => 796720932);
	$seconds = parsedate("last Tuesday");
	$seconds = parsedate("Sunday before last");

	($seconds, $remaining) = parsedate("today is the day");
	($seconds, $error) = parsedate("today is", WHOLE=>1);

package Time::ParseDate;

require 5.000;

use Carp;
use Time::Timezone;
use Time::JulianDay;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(parsedate);
@EXPORT_OK = qw(pd_raw %mtable %umult %wdays);

use strict;
#use diagnostics;

# constants
use vars qw(%mtable %umult %wdays $VERSION);

$VERSION = 2011.0517;

# globals
use vars qw($debug); 

# dynamically-scoped
use vars qw($parse);

my %mtable;
my %umult;
my %wdays;
my $y2k;

CONFIG:	{

	%mtable = qw(
		Jan 1	Jan. 1	January 1
		Feb 2	Feb. 2	February 2
		Mar 3	Mar. 3	March 3
		Apr 4	Apr. 4	April 4
		May 5 
		Jun 6	Jun. 6	June 6 
		Jul 7	Jul. 7	July 7 
		Aug 8	Aug. 8	August 8 
		Sep 9	Sep. 9	September 9 
		Oct 10	Oct. 10	October 10 
		Nov 11	Nov. 11	November 11 
		Dec 12	Dec. 12	December 12 );
	%umult = qw(
		sec 1 second 1
		min 60 minute 60
		hour 3600
		day 86400
		week 604800 
		fortnight 1209600);
	%wdays = qw(
		sun 0 sunday 0
		mon 1 monday 1
		tue 2 tuesday 2
		wed 3 wednesday 3
		thu 4 thursday 4
		fri 5 friday 5
		sat 6 saturday 6
		);

	$y2k = 946684800; # turn of the century
}

sub parsedate
{
	my ($t, %options) = @_;

	my ($y, $m, $d);	# year, month - 1..12, day
	my ($H, $M, $S);	# hour, minute, second
	my $tz;		 	# timezone
	my $tzo;		# timezone offset
	my ($rd, $rs);		# relative days, relative seconds

	my $rel; 		# time&|date is relative

	my $isspec;
	my $now = defined($options{NOW}) ? $options{NOW} : time;
	my $passes = 0;
	my $uk = defined($options{UK}) ? $options{UK} : 0;

	local $parse = '';  # will be dynamically scoped.

	if ($t =~ s#^   ([ \d]\d) 
						/ (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)
						/ (\d\d\d\d)
						: (\d\d)
						: (\d\d)
						: (\d\d)
						(?:
			 			 [ ]
			 			 ([-+] \d\d\d\d)
			  			  (?: \("?(?:(?:[A-Z]{1,4}[TCW56])|IDLE)\))?
			 			 )?
						##xi) { #"emacs
		# [ \d]/Mon/yyyy:hh:mm:ss [-+]\d\d\d\d
		# This is the format for www server logging.

		($d, $m, $y, $H, $M, $S, $tzo) = ($1, $mtable{"\u\L$2"}, $3, $4, $5, $6, $7 ? &mkoff($7) : ($tzo || undef));
		$parse .= " ".__LINE__ if $debug;
	} elsif ($t =~ s#^(\d\d)/(\d\d)/(\d\d)\.(\d\d)\:(\d\d)(\s+|$)##) {
		# yy/mm/dd.hh:mm
		# I support this format because it's used by wbak/rbak
		# on Apollo Domain OS.  Silly, but historical.

		($y, $m, $d, $H, $M, $S) = ($1, $2, $3, $4, $5, 0);
		$parse .= " ".__LINE__ if $debug;
	} else {
		while(1) {
			if (! defined $m and ! defined $rd and ! defined $y
				and ! ($passes == 0 and $options{'TIMEFIRST'}))
			{
				# no month defined.
				if (&parse_date_only(\$t, \$y, \$m, \$d, $uk)) {
					$parse .= " ".__LINE__ if $debug;
					next;
				}
			}
			if (! defined $H and ! defined $rs) {
				if (&parse_time_only(\$t, \$H, \$M, \$S, 
					\$tz, %options)) 
				{
					$parse .= " ".__LINE__ if $debug;
					next;
				}
			}
			next if $passes == 0 and $options{'TIMEFIRST'};
			if (! defined $y) {
				if (&parse_year_only(\$t, \$y, $now, %options)) {
					$parse .= " ".__LINE__ if $debug;
					next;
				}
			}
			if (! defined $tz and ! defined $tzo and ! defined $rs 
				and (defined $m or defined $H)) 
			{
				if (&parse_tz_only(\$t, \$tz, \$tzo)) {
					$parse .= " ".__LINE__ if $debug;
					next;
				}
			}
			if (! defined $H and ! defined $rs) {
				if (&parse_time_offset(\$t, \$rs, %options)) {
					$rel = 1;
					$parse .= " ".__LINE__ if $debug;
					next;
				}
			}
			if (! defined $m and ! defined $rd and ! defined $y) {
				if (&parse_date_offset(\$t, $now, \$y, 
					\$m, \$d, \$rd, \$rs, %options)) 
				{
					$rel = 1;
					$parse .= " ".__LINE__ if $debug;
					next;
				}
			}
			if (defined $M or defined $rd) {
				if ($t =~ s/^\s*(?:at|\@|\+)\s*(\s+|$)//x) {
					$rel = 1;
					$parse .= " ".__LINE__ if $debug;
					next;
				}
			}
			last;
		} continue {
			$passes++;
			&debug_display($tz, $tzo, $H, $M, $S, $m, $d, $y, $rs, $rd, $rel, $passes, $parse, $t) if $debug;

		}

		if ($passes == 0) {
			print "nothing matched\n" if $debug;
			return (undef, "no match on time/date") 
				if wantarray();
			return undef;
		}
	}

	&debug_display($tz, $tzo, $H, $M, $S, $m, $d, $y, $rs, $rd, $rel, $passes, $parse, $t) if $debug;

	$t =~ s/^\s+//;

	if ($t ne '') {
		# we didn't manage to eat the string
		print "NOT WHOLE\n" if $debug;
		if ($options{WHOLE}) {
			return (undef, "characters left over after parse")
				if wantarray();
			return undef 
		}
	}

	# define a date if there isn't one already

	if (! defined $y and ! defined $m and ! defined $rd) {
		print "no date defined, trying to find one." if $debug;
		if (defined $rs or defined $H) {
			# we do have a time.
			if ($options{DATE_REQUIRED}) {
				return (undef, "no date specified")
					if wantarray();
				return undef;
			}
			if (defined $rs) {
				print "simple offset: $rs\n" if $debug;
				my $rv = $now + $rs;
				return ($rv, $t) if wantarray();
				return $rv;
			}
			$rd = 0;
		} else {
			print "no time either!\n" if $debug;
			return (undef, "no time specified")
				if wantarray();
			return undef;
		}
	}

	if ($options{TIME_REQUIRED} && ! defined($rs) 
		&& ! defined($H) && ! defined($rd))
	{
		return (undef, "no time found")
			if wantarray();
		return undef;
	}

	my $secs;
	my $jd;

	if (defined $rd) {
		if (defined $rs || ! (defined($H) || defined($M) || defined($S))) {
			print "fully relative\n" if $debug;
			my ($j, $in, $it);
			my $definedrs = defined($rs) ? $rs : 0;
			my ($isdst_now, $isdst_then);
			my $r = $now + $rd * 86400 + $definedrs;
			#
			# It's possible that there was a timezone shift 
			# during the time specified.  If so, keep the
			# hours the "same".
			#
			$isdst_now = (localtime($r))[8];
			$isdst_then = (localtime($now))[8];
			if (($isdst_now == $isdst_then) || $options{GMT})
			{
				return ($r, $t) if wantarray();
				return $r 
			}
				
			print "localtime changed DST during time period!\n" if $debug;
		}

		print "relative date\n" if $debug;
		$jd = $options{GMT}
			? gm_julian_day($now)
			: local_julian_day($now);
		print "jd($now) = $jd\n" if $debug;
		$jd += $rd;
	} else {
		unless (defined $y) {
			if ($options{PREFER_PAST}) {
				my ($day, $mon011);
				($day, $mon011, $y) = (&righttime($now))[3,4,5];

				print "calc year -past $day-$d $mon011-$m $y\n" if $debug;
				$y -= 1 if ($mon011+1 < $m) || 
					(($mon011+1 == $m) && ($day < $d));
			} elsif ($options{PREFER_FUTURE}) {
				print "calc year -future\n" if $debug;
				my ($day, $mon011);
				($day, $mon011, $y) = (&righttime($now))[3,4,5];
				$y += 1 if ($mon011 >= $m) || 
					(($mon011+1 == $m) && ($day > $d));
			} else {
				print "calc year -this\n" if $debug;
				$y = (localtime($now))[5];
			}
			$y += 1900;
		}

		$y = expand_two_digit_year($y, $now, %options)
			if $y < 100;

		if ($options{VALIDATE}) {
			require Time::DaysInMonth;
			my $dim = Time::DaysInMonth::days_in($y, $m);
			if ($y < 1000 or $m < 1 or $d < 1 
				or $y > 9999 or $m > 12 or $d > $dim)
			{
				return (undef, "illegal YMD: $y, $m, $d")
					if wantarray();
				return undef;
			}
		}
		$jd = julian_day($y, $m, $d);
		print "jd($y, $m, $d) = $jd\n" if $debug;
	}

	# put time into HMS

	if (! defined($H)) {
		if (defined($rd) || defined($rs)) {
			($S, $M, $H) = &righttime($now, %options);
			print "HMS set to $H $M $S\n" if $debug;
		} 
	}

	my $carry;

	print "before ", (defined($rs) ? "$rs" : ""),
		    " $jd $H $M $S\n" 
		if $debug;
	#
	# add in relative seconds.  Do it this way because we want to
	# preserve the localtime across DST changes.
	#

	$S = 0 unless $S; # -w
	$M = 0 unless $M; # -w
	$H = 0 unless $H; # -w

	if ($options{VALIDATE} and
		($S < 0 or $M < 0 or $H < 0 or $S > 59 or $M > 59 or $H > 23)) 
	{
		return (undef, "illegal HMS: $H, $M, $S") if wantarray();
		return undef;
	}

	$S += $rs if defined $rs;
	$carry = int($S / 60) - ($S < 0 && $S % 60 && 1);
	$S -= $carry * 60;
	$M += $carry;
	$carry = int($M / 60) - ($M < 0 && $M % 60 && 1);
	$M %= 60;
	$H += $carry;
	$carry = int($H / 24) - ($H < 0 && $H % 24 && 1);
	$H %= 24;
	$jd += $carry;

	print "after rs  $jd $H $M $S\n" if $debug;

	$secs = jd_secondsgm($jd, $H, $M, $S);
	print "jd_secondsgm($jd, $H, $M, $S) = $secs\n" if $debug;

	# 
	# If we see something link 3pm CST then and we want to end
	# up with a GMT seconds, then we convert the 3pm to GMT and
	# subtract in the offset for CST.  We subtract because we
	# are converting from CST to GMT.
	#
	my $tzadj;
	if ($tz) {
		$tzadj = tz_offset($tz, $secs);
		if (defined $tzadj) {
			print "adjusting secs for $tz: $tzadj\n" if $debug;
			$tzadj = tz_offset($tz, $secs-$tzadj);
			$secs -= $tzadj;
		} else {
			print "unknown timezone: $tz\n" if $debug;
			undef $secs;
			undef $t;
		}
	} elsif (defined $tzo) {
		print "adjusting time for offset: $tzo\n" if $debug;
		$secs -= $tzo;
	} else {
		unless ($options{GMT}) {
			if ($options{ZONE}) {
				$tzadj = tz_offset($options{ZONE}, $secs) || 0;
				$tzadj = tz_offset($options{ZONE}, $secs-$tzadj);
				unless (defined($tzadj)) {
					return (undef, "could not convert '$options{ZONE}' to time offset")
						if wantarray();
					return undef;
				}
				print "adjusting secs for $options{ZONE}: $tzadj\n" if $debug;
				$secs -= $tzadj;
			} else {
				$tzadj = tz_local_offset($secs);
				print "adjusting secs for local offset: $tzadj\n" if $debug;
				# 
				# Just in case we are very close to a time
				# change...
				#
				$tzadj = tz_local_offset($secs-$tzadj);
				$secs -= $tzadj;
			}
		}
	}

	print "returning $secs.\n" if $debug;

	return ($secs, $t) if wantarray();
	return $secs;
}


sub mkoff
{
	my($offset) = @_;

	if (defined $offset and $offset =~ s#^([-+])(\d\d):?(\d\d)$##) {
		return ($1 eq '+' ? 
			  3600 * $2  + 60 * $3
			: -3600 * $2 + -60 * $3 );
	}
	return undef;
}

sub parse_tz_only
{
	my($tr, $tz, $tzo) = @_;

	$$tr =~ s#^\s+##;
	my $o;

	if ($$tr =~ s#^
						([-+]\d\d:?\d\d)
						\s+
						\(
								"?
								(?:
										(?:
												[A-Z]{1,4}[TCW56]
										)
										|
										IDLE
								)
						\)
						(?:
								\s+
								|
								$ 
						)
						##x) { #"emacs
		$$tzo = &mkoff($1);
		printf "matched at %d.\n", __LINE__ if $debug;
		return 1;
	} elsif ($$tr =~ s#^GMT\s*([-+]\d{1,2})(\s+|$)##x) {
		$o = $1;
		if ($o < 24 and $o !~ /^0/) {
			# probably hours.
			printf "adjusted at %d. ($o 00)\n", __LINE__ if $debug;
			$o = "${o}00";
		}
		$o =~ s/\b(\d\d\d)/0$1/;
		$$tzo = &mkoff($o);
		printf "matched at %d. ($$tzo, $o)\n", __LINE__ if $debug;
		return 1;
	} elsif ($$tr =~ s#^(?:GMT\s*)?([-+]\d\d:?\d\d)(\s+|$)##x) {
		$o = $1;
		$$tzo = &mkoff($o);
		printf "matched at %d.\n", __LINE__ if $debug;
		return 1;
	} elsif ($$tr =~ s#^"?((?:[A-Z]{1,4}[TCW56])|IDLE)(?:\s+|$ )##x) { #"
		$$tz = $1;
		$$tz .= " DST" 
			if $$tz eq 'MET' && $$tr =~ s#^DST(?:\s+|$ )##x;
		printf "matched at %d: '$$tz'.\n", __LINE__ if $debug;
		return 1;
	}
	return 0;
}

sub parse_date_only
{
	my ($tr, $yr, $mr, $dr, $uk) = @_;

	$$tr =~ s#^\s+##;

	if ($$tr =~ s#^(\d\d\d\d)([-./])(\d\d?)\2(\d\d?)(\s+|T|$)##) {
		# yyyy/mm/dd

		($$yr, $$mr, $$dr) = ($1, $3, $4);
		printf "matched at %d.\n", __LINE__ if $debug;
		return 1;
	} elsif ($$tr =~ s#^(\d\d?)([-./])(\d\d?)\2(\d\d\d\d?)(\s+|$)##) {
		# mm/dd/yyyy - is this safe?  No.
		# -- or dd/mm/yyyy! If $1>12, then it's umabiguous.
		# Otherwise check option UK for UK style date.
		if ($uk || $1>12) {
		  ($$yr, $$mr, $$dr) = ($4, $3, $1);
		} else {
		  ($$yr, $$mr, $$dr) = ($4, $1, $3);
		}
		printf "matched at %d.\n", __LINE__ if $debug;
		return 1;
	} elsif ($$tr =~ s#^(\d\d\d\d)/(\d\d?)(?:\s|$ )##x) {
		# yyyy/mm

		($$yr, $$mr, $$dr) = ($1, $2, 1);
		printf "matched at %d.\n", __LINE__ if $debug;
		return 1;
	} elsif ($$tr =~ s#^(?xi)
						(?:
								(?:Mon|Monday|Tue|Tuesday|Wed|Wednesday|
										Thu|Thursday|Fri|Friday|
										Sat|Saturday|Sun|Sunday),?
								\s+
						)?
						(\d\d?)
						(\s+ | - | \. | /)
						(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)\.?
						(?:
								\2
								(\d\d (?:\d\d)? )
						)?
						(?:
								\s+
						|
								$
						)
						##) {
		# [Dow,] dd Mon [yy[yy]]
		($$yr, $$mr, $$dr) = ($4, $mtable{"\u\L$3"}, $1);

		printf "%d: %s - %s - %s\n", __LINE__, $1, $2, $3 if $debug;
		print "y undef\n" if ($debug && ! defined($$yr));
		return 1;
	} elsif ($$tr =~ s#^(?xi)
						(?:
								(?:Mon|Monday|Tue|Tuesday|Wed|Wednesday|
										Thu|Thursday|Fri|Friday|
										Sat|Saturday|Sun|Sunday),?
								\s+
						)?
						(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)\.?
						((\s)+ | - | \. | /)
								
						(\d\d?)
						(?:
								(?: \2|\3+)
								(\d\d (?: \d\d)?)
						)?
						(?:
								\s+
						|
								$
						)
						##) {
		# [Dow,] Mon dd [yyyy]
		($$yr, $$mr, $$dr) = ($5, $mtable{"\u\L$1"}, $4);
		printf "%d: %s - %s - %s\n", __LINE__, $1, $2, $4 if $debug;
		print "y undef\n" if ($debug && ! defined($$yr));
		return 1;
	} elsif ($$tr =~ s#^(?xi)
						(January|Jan\.?|February|Feb\.?|March|Mar\.?|April|Apr\.?|May|
			    			    June|Jun\.?|July|Jul\.?|August|Aug\.?|September|Sep\.?|
			    			    October|Oct\.?|November|Nov\.?|December|Dec\.?)
						\s+
						(\d+)
						(?:st|nd|rd|th)?
						\,?
						(?: 
								\s+
								(?:
										(\d\d\d\d)
										|(?:\' (\d\d))
								)
						)?
						(?:
								\s+
						|
								$
						)
						##) {
		# Month day{st,nd,rd,th}, 'yy
		# Month day{st,nd,rd,th}, year
		($$yr, $$mr, $$dr) = ($3 || $4, $mtable{"\u\L$1"}, $2);
		printf "%d: %s - %s - %s - %s\n", __LINE__, $1, $2, $3, $4 if $debug;
		print "y undef\n" if ($debug && ! defined($$yr));
		printf "matched at %d.\n", __LINE__ if $debug;
		return 1;
	} elsif ($$tr =~ s#^(\d\d?)([-/.])(\d\d?)\2(\d\d?)(\s+|$)##x) {
		if ($1 > 31 || (!$uk && $1 > 12 && $4 < 32)) {
			# yy/mm/dd
			($$yr, $$mr, $$dr) = ($1, $3, $4);
		} elsif ($1 > 12 || $uk) {
			# dd/mm/yy
			($$yr, $$mr, $$dr) = ($4, $3, $1);
		} else {
			# mm/dd/yy
			($$yr, $$mr, $$dr) = ($4, $1, $3);
		}
		printf "matched at %d.\n", __LINE__ if $debug;
		return 1;
	} elsif ($$tr =~ s#^(\d\d?)/(\d\d?)(\s+|$)##x) {
		if ($1 > 31 || (!$uk && $1 > 12)) {
			# yy/mm
			($$yr, $$mr, $$dr) = ($1, $2, 1);
		} elsif ($2 > 31 || ($uk && $2 > 12)) {
			# mm/yy
			($$yr, $$mr, $$dr) = ($2, $1, 1);
		} elsif ($1 > 12 || $uk) {
			# dd/mm
			($$mr, $$dr) = ($2, $1);
		} else {
			# mm/dd
			($$mr, $$dr) = ($1, $2);
		}
		printf "matched at %d.\n", __LINE__ if $debug;
		return 1;
	} elsif ($$tr =~ s#^(\d\d)(\d\d)(\d\d)(\s+|$)##x) {
		if ($1 > 31 || (!$uk && $1 > 12)) {
			# YYMMDD
			($$yr, $$mr, $$dr) = ($1, $2, $3);
		} elsif ($1 > 12 || $uk) {
			# DDMMYY
			($$yr, $$mr, $$dr) = ($3, $2, $1);
		} else {
			# MMDDYY
			($$yr, $$mr, $$dr) = ($3, $1, $2);
		}
		printf "matched at %d.\n", __LINE__ if $debug;
		return 1;
	} elsif ($$tr =~ s#^(?xi)
						(\d{1,2})
						(\s+ | - | \. | /)
						(January|Jan\.?|February|Feb\.?|March|Mar\.?|April|Apr\.?|May|
			    			    June|Jun\.?|July|Jul\.?|August|Aug\.?|September|Sep\.?|
			    			    October|Oct\.?|November|Nov\.?|December|Dec\.?)
						(?:
								\2
								(
										\d\d
										(?:\d\d)?
								)
						)
						(:?
								\s+
						|
								$
						)
						##) {
		# dd Month [yr]
		($$yr, $$mr, $$dr) = ($4, $mtable{"\u\L$3"}, $1);
		printf "matched at %d.\n", __LINE__ if $debug;
		return 1;
	} elsif ($$tr =~ s#^(?xi)
						(\d+)
						(?:st|nd|rd|th)?
						\s+
						(January|Jan\.?|February|Feb\.?|March|Mar\.?|April|Apr\.?|May|
			    			    June|Jun\.?|July|Jul\.?|August|Aug\.?|September|Sep\.?|
			    			    October|Oct\.?|November|Nov\.?|December|Dec\.?)
						(?: 
								\,?
								\s+
								(\d\d\d\d)
						)?
						(:?
								\s+
						|
								$
						)
						##) {
		# day{st,nd,rd,th}, Month year
		($$yr, $$mr, $$dr) = ($3, $mtable{"\u\L$2"}, $1);
		printf "%d: %s - %s - %s - %s\n", __LINE__, $1, $2, $3, $4 if $debug;
		print "y undef\n" if ($debug && ! defined($$yr));
		printf "matched at %d.\n", __LINE__ if $debug;
		return 1;
	}
	return 0;
}

sub parse_time_only
{
	my ($tr, $hr, $mr, $sr, $tzr, %options) = @_;

	$$tr =~ s#^\s+##;

	if ($$tr =~ s!^(?x)
						(?:
								(?:
										([012]\d)		(?# $1)
										(?:
												([0-5]\d) 	(?# $2)
												(?:
						    						    ([0-5]\d)	(?# $3)
												)?
										)
										\s*
										([apAP][mM])?  		(?# $4)
								) | (?:
										(\d{1,2}) 		(?# $5)
										(?:
												\:
												(\d\d)		(?# $6)
												(?:
														\:
														(\d\d)	(?# $7)
																(
																		(?# don't barf on database sub-second timings)
																		[:.,]
																		\d{1,6}
																)?	(?# $8)
												)?
										)
										\s*
										([apAP][mM])?		(?# $9)
								) | (?:
										(\d{1,2})		(?# $10)
										([apAP][mM])		(?# ${11})
								)
						)
						(?:
								\s+
								"?
								(				(?# ${12})
										(?: [A-Z]{1,4}[TCW56] )
										|
										IDLE
								)	
						)?
						(?:
								\s*
						|
								$
						)
						!!) { #"emacs
		# HH[[:]MM[:SS]]meridan [zone] 
		my $ampm;
		$$hr = $1 || $5 || $10 || 0; # 10 is undef, but 5 is defined..
		$$mr = $2 || $6 || 0;
		$$sr = $3 || $7 || 0;
		if (defined($8) && exists($options{SUBSECOND}) && $options{SUBSECOND}) {
			my($frac) = $8;
			substr($frac,0,1) = '.';
			$$sr += $frac;
		}
		print "S = $$sr\n" if $debug;
		$ampm = $4 || $9 || $11 || '';
		$$tzr = $12;
		$$hr += 12 if $ampm and "\U$ampm" eq "PM" && $$hr != 12;
		$$hr = 0 if $$hr == 12 && "\U$ampm" eq "AM";
		printf "matched at %d, rem = %s.\n", __LINE__, $$tr if $debug;
		return 1;
	} elsif ($$tr =~ s#^noon(?:\s+|$ )##ix) {
		# noon
		($$hr, $$mr, $$sr) = (12, 0, 0);
		printf "matched at %d.\n", __LINE__ if $debug;
		return 1;
	} elsif ($$tr =~ s#^midnight(?:\s+|$ )##ix) {
		# midnight
		($$hr, $$mr, $$sr) = (0, 0, 0);
		printf "matched at %d.\n", __LINE__ if $debug;
		return 1;
	}
	return 0;
}

sub parse_time_offset
{
	my ($tr, $rsr, %options) = @_;

	$$tr =~ s/^\s+//;

	return 0 if $options{NO_RELATIVE};

	if ($$tr =~ s{^(?xi)					
						(?:
								(-)				(?# 1)
								|
								[+]
						)?
						\s*
						(?:
								(\d+(?:\.\d+)?) 		(?# 2)
								| 		
								(?:(\d+)\s+(\d+)/(\d+))		(?# 3 4/5)
						)
						\s*
						(sec|second|min|minute|hour)s?		(?# 6)
						(
								\s+
								ago				(?# 7)
						)?
						(?:
								\s+
								|
								$
						)
						}{}) {
		# count units
		$$rsr = 0 unless defined $$rsr;
		return 0 if defined($5) && $5 == 0;
		my $num = defined($2)
			? $2
			: $3 + $4/$5;
		$num = -$num if $1;
		$$rsr += $umult{"\L$6"} * $num;

		$$rsr = -$$rsr if $7 ||
			$$tr =~ /\b(day|mon|month|year)s?\s*ago\b/;
		printf "matched at %d.\n", __LINE__ if $debug;
		return 1;
	} 
	return 0;
}

#
# What to you do with a date that has a two-digit year?
# There's not much that can be done except make a guess.
#
# Some example situations to handle:
#
#	now		year 
#
#	1999		01
#	1999		71
#	2010		71
#	2110		09
#

sub expand_two_digit_year
{
	my ($yr, $now, %options) = @_;

	return $yr if $yr > 100;

	my ($y) = (&righttime($now, %options))[5];
	$y += 1900;
	my $century = int($y / 100) * 100;
	my $within = $y % 100;

	my $r = $yr + $century;

	if ($options{PREFER_PAST}) {
		if ($yr > $within) {
			$r = $yr + $century - 100;
		}
	} elsif ($options{PREFER_FUTURE}) {
		# being strict here would be silly
		if ($yr < $within-20) {
			# it's 2019 and the date is '08'
			$r = $yr + $century + 100;
		}
	} elsif ($options{UNAMBIGUOUS}) {
		# we really shouldn't guess
		return undef;
	} else {
		# prefer the current century in most cases

		if ($within > 80 && $within - $yr > 60) {
			$r = $yr + $century + 100;
		}

		if ($within < 30 && $yr - $within > 59) {
			$r = $yr + $century - 100;
		}
	}
	print "two digit year '$yr' expanded into $r\n" if $debug;
	return $r;
}


sub calc 
{
	my ($rsr, $yr, $mr, $dr, $rdr, $now, $units, $count, %options) = @_;

	confess unless $units;
	$units = "\L$units";
	print "calc based on $units\n" if $debug;

	if ($units eq 'day') {
		$$rdr = $count;
	} elsif ($units eq 'week') {
		$$rdr = $count * 7;
	} elsif ($umult{$units}) {
		$$rsr = $count * $umult{$units};
	} elsif ($units eq 'mon' || $units eq 'month') {
		($$yr, $$mr, $$dr) = &monthoff($now, $count, %options);
		$$rsr = 0 unless $$rsr;
	} elsif ($units eq 'year') {
		($$yr, $$mr, $$dr) = &monthoff($now, $count * 12, %options);
		$$rsr = 0 unless $$rsr;
	} else {
		carp "interal error";
	}
	print "calced rsr $$rsr rdr $$rdr, yr $$yr mr $$mr dr $$dr.\n" if $debug;
}

sub monthoff
{
	my ($now, $months, %options) = @_;

	# months are 0..11
	my ($d, $m11, $y) = (&righttime($now, %options)) [ 3,4,5 ] ;

	$y += 1900;

	print "m11 = $m11 + $months, y = $y\n" if $debug;

	$m11 += $months;

	print "m11 = $m11, y = $y\n" if $debug;
	if ($m11 > 11 || $m11 < 0) {
		$y -= 1 if $m11 < 0 && ($m11 % 12 != 0);
		$y += int($m11/12);

		# this is required to work around a bug in perl 5.003
		no integer;
		$m11 %= 12;
	}
	print "m11 = $m11, y = $y\n" if $debug;

	# 
	# What is "1 month from January 31st?"  
	# I think the answer is February 28th most years.
	#
	# Similarly, what is one year from February 29th, 1980?
	# I think it's February 28th, 1981.
	#
	# If you disagree, change the following code.
	#
	if ($d > 30 or ($d > 28 && $m11 == 1)) {
		require Time::DaysInMonth;
		my $dim = Time::DaysInMonth::days_in($y, $m11+1);
		print "dim($y,$m11+1)= $dim\n" if $debug;
		$d = $dim if $d > $dim;
	}
	return ($y, $m11+1, $d);
}

sub righttime
{
	my ($time, %options) = @_;
	if ($options{GMT}) {
		return gmtime($time);
	} else {
		return localtime($time);
	}
}

sub parse_year_only
{
	my ($tr, $yr, $now, %options) = @_;

	$$tr =~ s#^\s+##;

	if ($$tr =~ s#^(\d\d\d\d)(?:\s+|$)##) {
		$$yr = $1;
		printf "matched at %d.\n", __LINE__ if $debug;
		return 1;
	} elsif ($$tr =~ s#\'(\d\d)(?:\s+|$ )##) {
		$$yr = expand_two_digit_year($1, $now, %options);
		printf "matched at %d.\n", __LINE__ if $debug;
		return 1;
	}
	return 0;
}

sub parse_date_offset
{
	my ($tr, $now, $yr, $mr, $dr, $rdr, $rsr, %options) = @_;

	return 0 if $options{NO_RELATIVE};

	# now - current seconds_since_epoch
	# yr - year return
	# mr - month return
	# dr - day return
	# rdr - relatvie day return
	# rsr - relative second return

	my $j;
	my $wday = (&righttime($now, %options))[6];

	$$tr =~ s#^\s+##;

	if ($$tr =~ s#^(?xi)
						\s*
						(\d+)
						\s*
						(day|week|month|year)s?
						(
								\s+
								ago
						)?
						(?:
								\s+
								|
								$
						)
						##) {
		my $amt = $1 + 0;
		my $units = $2;
		$amt = -$amt if $3 ||
			$$tr =~ m#\b(sec|second|min|minute|hour)s?\s*ago\b#;
		&calc($rsr, $yr, $mr, $dr, $rdr, $now, $units, 
			$amt, %options);
		printf "matched at %d.\n", __LINE__ if $debug;
		return 1;
	} elsif ($$tr =~ s#^(?xi)
						(?:
								(?:
										now
										\s+
								)?
								(\+ | \-)
								\s*
						)?
						(\d+)
						\s*
						(day|week|month|year)s?
						(?:
								\s+
								|
								$
						)
						##) {
		my $one = $1 || '';
		my $two = $2 || '';
		my $amt = "$one$two"+0;
		&calc($rsr, $yr, $mr, $dr, $rdr, $now, $3, 
			$amt, %options);
		printf "matched at %d.\n", __LINE__ if $debug;
		return 1;
	} elsif ($$tr =~ s#^(?xi)
						(Mon|Tue|Wed|Thu|Fri|Sat|Sun|Monday|Tuesday
								|Wednesday|Thursday|Friday|Saturday|Sunday)
						\s+
						after
						\s+
						next
						(?: \s+ | $ )
						##) {
		# Dow "after next"
		$$rdr = $wdays{"\L$1"} - $wday + ( $wdays{"\L$1"} > $wday ? 7 : 14);
		printf "matched at %d.\n", __LINE__ if $debug;
		return 1;
	} elsif ($$tr =~ s#^(?xi)
						(Mon|Tue|Wed|Thu|Fri|Sat|Sun|Monday|Tuesday
								|Wednesday|Thursday|Friday|Saturday|Sunday)
						\s+
						before
						\s+
						last
						(?: \s+ | $ )
						##) {
		# Dow "before last"
		$$rdr = $wdays{"\L$1"} - $wday - ( $wdays{"\L$1"} < $wday ? 7 : 14);
		printf "matched at %d.\n", __LINE__ if $debug;
		return 1;
	} elsif ($$tr =~ s#^(?xi)
						next\s+
						(Mon|Tue|Wed|Thu|Fri|Sat|Sun|Monday|Tuesday
								|Wednesday|Thursday|Friday|Saturday|Sunday)
						(?:\s+|$ )
						##) {
		# "next" Dow
		$$rdr = $wdays{"\L$1"} - $wday 
				+ ( $wdays{"\L$1"} > $wday ? 0 : 7);
		printf "matched at %d.\n", __LINE__ if $debug;
		return 1;
	} elsif ($$tr =~ s#^(?xi)
						last\s+
						(Mon|Tue|Wed|Thu|Fri|Sat|Sun|Monday|Tuesday
								|Wednesday|Thursday|Friday|Saturday|Sunday)
						(?:\s+|$ )##) {
		# "last" Dow
		printf "c %d - %d + ( %d < %d ? 0 : -7 \n", $wdays{"\L$1"},  $wday,  $wdays{"\L$1"}, $wday if $debug;
		$$rdr = $wdays{"\L$1"} - $wday + ( $wdays{"\L$1"} < $wday ? 0 : -7);
		printf "matched at %d.\n", __LINE__ if $debug;
		return 1;
	} elsif ($options{PREFER_PAST} and $$tr =~ s#^(?xi)
						(Mon|Tue|Wed|Thu|Fri|Sat|Sun|Monday|Tuesday
								|Wednesday|Thursday|Friday|Saturday|Sunday)
						(?:\s+|$ )##) {
		# Dow
		printf "c %d - %d + ( %d < %d ? 0 : -7 \n", $wdays{"\L$1"},  $wday,  $wdays{"\L$1"}, $wday if $debug;
		$$rdr = $wdays{"\L$1"} - $wday + ( $wdays{"\L$1"} < $wday ? 0 : -7);
		printf "matched at %d.\n", __LINE__ if $debug;
		return 1;
	} elsif ($options{PREFER_FUTURE} and $$tr =~ s#^(?xi)
						(Mon|Tue|Wed|Thu|Fri|Sat|Sun|Monday|Tuesday
								|Wednesday|Thursday|Friday|Saturday|Sunday)
						(?:\s+|$ )
						##) {
		# Dow
		$$rdr = $wdays{"\L$1"} - $wday 
				+ ( $wdays{"\L$1"} > $wday ? 0 : 7);
		printf "matched at %d.\n", __LINE__ if $debug;
		return 1;
	} elsif ($$tr =~ s#^today(?:\s+|$ )##xi) {
		# today
		$$rdr = 0;
		printf "matched at %d.\n", __LINE__ if $debug;
		return 1;
	} elsif ($$tr =~ s#^tomorrow(?:\s+|$ )##xi) {
		$$rdr = 1;
		printf "matched at %d.\n", __LINE__ if $debug;
		return 1;
	} elsif ($$tr =~ s#^yesterday(?:\s+|$ )##xi) {
		$$rdr = -1;
		printf "matched at %d.\n", __LINE__ if $debug;
		return 1;
	} elsif ($$tr =~ s#^last\s+(week|month|year)(?:\s+|$ )##xi) {
		&calc($rsr, $yr, $mr, $dr, $rdr, $now, $1, -1, %options);
		printf "matched at %d.\n", __LINE__ if $debug;
		return 1;
	} elsif ($$tr =~ s#^next\s+(week|month|year)(?:\s+|$ )##xi) {
		&calc($rsr, $yr, $mr, $dr, $rdr, $now, $1, 1, %options);
		printf "matched at %d.\n", __LINE__ if $debug;
		return 1;
	} elsif ($$tr =~ s#^now (?: \s+ | $ )##x) {
		$$rdr = 0;
		return 1;
	}
	return 0;
}

sub debug_display
{
	my ($tz, $tzo, $H, $M, $S, $m, $d, $y, $rs, $rd, $rel, $passes, $parse, $t) = @_;
	print "---------<<\n";
	print defined($tz) ? "tz: $tz.\n" : "no tz\n";
	print defined($tzo) ? "tzo: $tzo.\n" : "no tzo\n";
	print "HMS: ";
	print defined($H) ? "$H, " : "no H, ";
	print defined($M) ? "$M, " : "no M, ";
	print defined($S) ? "$S\n" : "no S.\n";
	print "mdy: ";
	print defined($m) ? "$m, " : "no m, ";
	print defined($d) ? "$d, " : "no d, ";
	print defined($y) ? "$y\n" : "no y.\n";
	print defined($rs) ? "rs: $rs.\n" : "no rs\n";
	print defined($rd) ? "rd: $rd.\n" : "no rd\n";
	print $rel ? "relative\n" : "not relative\n";
	print "passes: $passes\n";
	print "parse:$parse\n";
	print "t: $t.\n";
	print "--------->>\n";
}
1;

__END__