package DateTime::Format::Strptime;

use strict;
use DateTime;
use DateTime::Locale;
use DateTime::TimeZone;
use Params::Validate qw( validate SCALAR BOOLEAN OBJECT CODEREF );
use Carp;

use Exporter;
use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK %ZONEMAP %FORMATS $CROAK $errmsg);

@ISA = 'Exporter';
$VERSION = '1.0700';
@EXPORT_OK = qw( &strftime &strptime );
@EXPORT = ();

%ZONEMAP = (
     'A' => '+0100',       'ACDT' => '+1030',       'ACST' => '+0930',
   'ADT' => 'Ambiguous',   'AEDT' => '+1100',        'AES' => '+1000',
  'AEST' => '+1000',        'AFT' => '+0430',       'AHDT' => '-0900',
  'AHST' => '-1000',       'AKDT' => '-0800',       'AKST' => '-0900',
  'AMST' => '+0400',        'AMT' => '+0400',      'ANAST' => '+1300',
  'ANAT' => '+1200',        'ART' => '-0300',        'AST' => 'Ambiguous',
    'AT' => '-0100',       'AWST' => '+0800',      'AZOST' => '+0000',
  'AZOT' => '-0100',       'AZST' => '+0500',        'AZT' => '+0400',
     'B' => '+0200',       'BADT' => '+0400',        'BAT' => '+0600',
  'BDST' => '+0200',        'BDT' => '+0600',        'BET' => '-1100',
   'BNT' => '+0800',       'BORT' => '+0800',        'BOT' => '-0400',
   'BRA' => '-0300',        'BST' => 'Ambiguous',     'BT' => 'Ambiguous',
   'BTT' => '+0600',          'C' => '+0300',       'CAST' => '+0930',
   'CAT' => 'Ambiguous',    'CCT' => 'Ambiguous',    'CDT' => 'Ambiguous',
  'CEST' => '+0200',        'CET' => '+0100',     'CETDST' => '+0200',
 'CHADT' => '+1345',      'CHAST' => '+1245',        'CKT' => '-1000',
  'CLST' => '-0300',        'CLT' => '-0400',        'COT' => '-0500',
   'CST' => 'Ambiguous',   'CSuT' => '+1030',        'CUT' => '+0000',
   'CVT' => '-0100',        'CXT' => '+0700',       'ChST' => '+1000',
     'D' => '+0400',       'DAVT' => '+0700',       'DDUT' => '+1000',
   'DNT' => '+0100',        'DST' => '+0200',          'E' => '+0500',
 'EASST' => '-0500',       'EAST' => 'Ambiguous',    'EAT' => '+0300',
   'ECT' => 'Ambiguous',    'EDT' => 'Ambiguous',   'EEST' => '+0300',
   'EET' => '+0200',     'EETDST' => '+0300',       'EGST' => '+0000',
   'EGT' => '-0100',        'EMT' => '+0100',        'EST' => 'Ambiguous',
  'ESuT' => '+1100',          'F' => '+0600',        'FDT' => 'Ambiguous',
  'FJST' => '+1300',        'FJT' => '+1200',       'FKST' => '-0300',
   'FKT' => '-0400',        'FST' => 'Ambiguous',    'FWT' => '+0100',
     'G' => '+0700',       'GALT' => '-0600',       'GAMT' => '-0900',
  'GEST' => '+0500',        'GET' => '+0400',        'GFT' => '-0300',
  'GILT' => '+1200',        'GMT' => '+0000',        'GST' => 'Ambiguous',
    'GT' => '+0000',        'GYT' => '-0400',         'GZ' => '+0000',
     'H' => '+0800',        'HAA' => '-0300',        'HAC' => '-0500',
   'HAE' => '-0400',        'HAP' => '-0700',        'HAR' => '-0600',
   'HAT' => '-0230',        'HAY' => '-0800',        'HDT' => '-0930',
   'HFE' => '+0200',        'HFH' => '+0100',         'HG' => '+0000',
   'HKT' => '+0800',         'HL' => 'local',        'HNA' => '-0400',
   'HNC' => '-0600',        'HNE' => '-0500',        'HNP' => '-0800',
   'HNR' => '-0700',        'HNT' => '-0330',        'HNY' => '-0900',
   'HOE' => '+0100',        'HST' => '-1000',          'I' => '+0900',
   'ICT' => '+0700',       'IDLE' => '+1200',       'IDLW' => '-1200',
   'IDT' => 'Ambiguous',    'IOT' => '+0500',       'IRDT' => '+0430',
 'IRKST' => '+0900',       'IRKT' => '+0800',       'IRST' => '+0430',
   'IRT' => '+0330',        'IST' => 'Ambiguous',     'IT' => '+0330',
   'ITA' => '+0100',       'JAVT' => '+0700',       'JAYT' => '+0900',
   'JST' => '+0900',         'JT' => '+0700',          'K' => '+1000',
   'KDT' => '+1000',       'KGST' => '+0600',        'KGT' => '+0500',
  'KOST' => '+1200',      'KRAST' => '+0800',       'KRAT' => '+0700',
   'KST' => '+0900',          'L' => '+1100',       'LHDT' => '+1100',
  'LHST' => '+1030',       'LIGT' => '+1000',       'LINT' => '+1400',
   'LKT' => '+0600',        'LST' => 'local',         'LT' => 'local',
     'M' => '+1200',      'MAGST' => '+1200',       'MAGT' => '+1100',
   'MAL' => '+0800',       'MART' => '-0930',        'MAT' => '+0300',
  'MAWT' => '+0600',        'MDT' => '-0600',        'MED' => '+0200',
 'MEDST' => '+0200',       'MEST' => '+0200',       'MESZ' => '+0200',
   'MET' => 'Ambiguous',   'MEWT' => '+0100',        'MEX' => '-0600',
   'MEZ' => '+0100',        'MHT' => '+1200',        'MMT' => '+0630',
   'MPT' => '+1000',        'MSD' => '+0400',        'MSK' => '+0300',
  'MSKS' => '+0400',        'MST' => '-0700',         'MT' => '+0830',
   'MUT' => '+0400',        'MVT' => '+0500',        'MYT' => '+0800',
     'N' => '-0100',        'NCT' => '+1100',        'NDT' => '-0230',
   'NFT' => 'Ambiguous',    'NOR' => '+0100',      'NOVST' => '+0700',
  'NOVT' => '+0600',        'NPT' => '+0545',        'NRT' => '+1200',
   'NST' => 'Ambiguous',   'NSUT' => '+0630',         'NT' => '-1100',
   'NUT' => '-1100',       'NZDT' => '+1300',       'NZST' => '+1200',
   'NZT' => '+1200',          'O' => '-0200',       'OESZ' => '+0300',
   'OEZ' => '+0200',      'OMSST' => '+0700',       'OMST' => '+0600',
    'OZ' => 'local',          'P' => '-0300',        'PDT' => '-0700',
   'PET' => '-0500',      'PETST' => '+1300',       'PETT' => '+1200',
   'PGT' => '+1000',       'PHOT' => '+1300',        'PHT' => '+0800',
   'PKT' => '+0500',       'PMDT' => '-0200',        'PMT' => '-0300',
   'PNT' => '-0830',       'PONT' => '+1100',        'PST' => 'Ambiguous',
   'PWT' => '+0900',       'PYST' => '-0300',        'PYT' => '-0400',
     'Q' => '-0400',          'R' => '-0500',        'R1T' => '+0200',
   'R2T' => '+0300',        'RET' => '+0400',        'ROK' => '+0900',
     'S' => '-0600',       'SADT' => '+1030',       'SAST' => 'Ambiguous',
   'SBT' => '+1100',        'SCT' => '+0400',        'SET' => '+0100',
   'SGT' => '+0800',        'SRT' => '-0300',        'SST' => 'Ambiguous',
   'SWT' => '+0100',          'T' => '-0700',        'TFT' => '+0500',
   'THA' => '+0700',       'THAT' => '-1000',        'TJT' => '+0500',
   'TKT' => '-1000',        'TMT' => '+0500',        'TOT' => '+1300',
  'TRUT' => '+1000',        'TST' => '+0300',       'TUC ' => '+0000',
   'TVT' => '+1200',          'U' => '-0800',      'ULAST' => '+0900',
  'ULAT' => '+0800',       'USZ1' => '+0200',      'USZ1S' => '+0300',
  'USZ3' => '+0400',      'USZ3S' => '+0500',       'USZ4' => '+0500',
 'USZ4S' => '+0600',       'USZ5' => '+0600',      'USZ5S' => '+0700',
  'USZ6' => '+0700',      'USZ6S' => '+0800',       'USZ7' => '+0800',
 'USZ7S' => '+0900',       'USZ8' => '+0900',      'USZ8S' => '+1000',
  'USZ9' => '+1000',      'USZ9S' => '+1100',        'UTZ' => '-0300',
   'UYT' => '-0300',       'UZ10' => '+1100',      'UZ10S' => '+1200',
  'UZ11' => '+1200',      'UZ11S' => '+1300',       'UZ12' => '+1200',
 'UZ12S' => '+1300',        'UZT' => '+0500',          'V' => '-0900',
   'VET' => '-0400',      'VLAST' => '+1100',       'VLAT' => '+1000',
   'VTZ' => '-0200',        'VUT' => '+1100',          'W' => '-1000',
  'WAKT' => '+1200',       'WAST' => 'Ambiguous',    'WAT' => '+0100',
  'WEST' => '+0100',       'WESZ' => '+0100',        'WET' => '+0000',
'WETDST' => '+0100',        'WEZ' => '+0000',        'WFT' => '+1200',
  'WGST' => '-0200',        'WGT' => '-0300',        'WIB' => '+0700',
   'WIT' => '+0900',       'WITA' => '+0800',        'WST' => 'Ambiguous',
   'WTZ' => '-0100',        'WUT' => '+0100',          'X' => '-1100',
     'Y' => '-1200',      'YAKST' => '+1000',       'YAKT' => '+0900',
  'YAPT' => '+1000',        'YDT' => '-0800',      'YEKST' => '+0600',
  'YEKT' => '+0500',        'YST' => '-0900',          'Z' => '+0000',
);

sub new {
    my $class = shift;
	my %args = validate( @_, {	pattern		=> { type => SCALAR },
								time_zone	=> { type => SCALAR | OBJECT, optional => 1 },
                                locale      => { type => SCALAR | OBJECT, default => 'English' },
								on_error	=> { type => SCALAR | CODEREF, default => 'undef' },
								diagnostic	=> { type => SCALAR, default => 0 },
                             }
                       );

	croak("The value supplied to on_error must be either 'croak', 'undef' or a code reference.")
		unless ref($args{on_error}) eq 'CODE'
			or $args{on_error} eq 'croak'
			or $args{on_error} eq 'undef';


	# Deal with locale
	unless (ref ($args{locale})) {
        my $locale = DateTime::Locale->load( $args{locale} );

		croak("Could not create locale from $args{locale}") unless $locale;

		$args{_locale} = $locale;
	} else {
		$args{_locale} = $args{locale};
		($args{locale}) = ref($args{_locale}) =~/::(\w+)[^:]+$/
	}

	if ($args{time_zone}) {
		unless (ref ($args{time_zone})) {
			$args{time_zone} = DateTime::TimeZone->new( name => $args{time_zone} );

			croak("Could not create time zone from $args{time_zone}") unless $args{time_zone};
		}
		$args{set_time_zone} = $args{time_zone};
	} else {
		$args{time_zone} = DateTime::TimeZone->new( name => 'floating' );
		$args{set_time_zone} = '';
	}


    my $self = bless \%args, $class;


	# Deal with the parser
	$self->{parser} = $self->_build_parser($args{pattern});
	if ($self->{parser}=~/(%\{\w+\}|%\w)/ and $args{pattern} !~ /\%$1/) {
		croak("Unidentified token in pattern: $1 in $self->{pattern}");
	}

	return $self;
}

sub pattern {
	my $self = shift;
	my $pattern = shift;

	if ($pattern) {
		my $possible_parser = $self->_build_parser($pattern);
		if ($possible_parser=~/(%\{\w+\}|%\w)/ and $pattern !~ /\%$1/) {
			$self->local_carp("Unidentified token in pattern: $1 in $pattern. Leaving old pattern intact.") and return undef;
		} else {
			$self->{parser} = $possible_parser;
			$self->{pattern} = $pattern;
		}
	}
	return $self->{pattern};
}

sub locale {
	my $self = shift;
	my $locale = shift;

	if ($locale) {
               my $possible_locale = DateTime::Locale->load( $locale );
		unless ($possible_locale) {
			$self->local_carp("Could not create locale from $locale. Leaving old locale intact.") and return undef;
		} else {
			$self->{locale} = $locale;
			$self->{_locale} = $possible_locale;
			# When the locale changes we need to rebuild the parser
			$self->{parser} = $self->_build_parser($self->{pattern});
		}
	}
	return $self->{locale};
}

sub time_zone {
	my $self = shift;
	my $time_zone = shift;

	if ($time_zone) {
		my $possible_time_zone = DateTime::TimeZone->new( name => $time_zone );
		unless ($possible_time_zone) {
			$self->local_carp("Could not create time zone from $time_zone. Leaving old time zone intact.") and return undef;
		} else {
			$self->{time_zone} = $possible_time_zone;
			$self->{set_time_zone} = $self->{time_zone};
		}
	}
	return $self->{time_zone}->name;
}


sub parse_datetime {
    my ( $self, $time_string ) = @_;

	local $^W = undef;

	# Variables from the parser
	my (	$dow_name, 		$month_name,	$century, 		$day,
			$hour_24, 		$hour_12, 		$doy, 			$month,
			$minute, 		$ampm, 			$second, 		$week_sun_0,
			$dow_sun_0,		$dow_mon_1,		$week_mon_1,	$year_100,
			$year,			$iso_week_year_100,				$iso_week_year,
			$epoch,			$tz_offset,		$timezone,		$tz_olson,
			$nanosecond,	$ce_year,

			$doy_dt,		$epoch_dt, 		$use_timezone,  $set_time_zone,
		);

	# Variables for DateTime
	my (	$Year,			$Month,			$Day,
			$Hour,			$Minute,		$Second,		$Nanosecond,
		$Am, $Pm
		) = ();

	# Run the parser
	my $parser = $self->{parser};
	eval($parser);
	die $@ if $@;

	if ($self->{diagnostic}) {
		print qq|

Entered     = $time_string
Parser		= $parser

dow_name    = $dow_name
month_name  = $month_name
century     = $century
day         = $day
hour_24     = $hour_24
hour_12     = $hour_12
doy         = $doy
month       = $month
minute      = $minute
ampm        = $ampm
second      = $second
nanosecond  = $nanosecond
week_sun_0  = $week_sun_0
dow_sun_0   = $dow_sun_0
dow_mon_1   = $dow_mon_1
week_mon_1  = $week_mon_1
year_100    = $year_100
year        = $year
ce_year     = $ce_year
tz_offset   = $tz_offset
tz_olson    = $tz_olson
timezone    = $timezone
epoch       = $epoch
iso_week_year     = $iso_week_year
iso_week_year_100 = $iso_week_year_100

		|;

	}

	$self->local_croak("Your datetime does not match your pattern.") and return undef
		if (
			($self->{parser}=~/\$dow_name\b/ and $dow_name eq '') or
			($self->{parser}=~/\$month_name\b/ and $month_name eq '') or
			($self->{parser}=~/\$century\b/ and $century eq '') or
			($self->{parser}=~/\$day\b/ and $day eq '') or
			($self->{parser}=~/\$hour_24\b/ and $hour_24 eq '') or
			($self->{parser}=~/\$hour_12\b/ and $hour_12 eq '') or
			($self->{parser}=~/\$doy\b/ and $doy eq '') or
			($self->{parser}=~/\$month\b/ and $month eq '') or
			($self->{parser}=~/\$minute\b/ and $minute eq '') or
			($self->{parser}=~/\$ampm\b/ and $ampm eq '') or
			($self->{parser}=~/\$second\b/ and $second eq '') or
			($self->{parser}=~/\$nanosecond\b/ and $nanosecond eq '') or
			($self->{parser}=~/\$week_sun_0\b/ and $week_sun_0 eq '') or
			($self->{parser}=~/\$dow_sun_0\b/ and $dow_sun_0 eq '') or
			($self->{parser}=~/\$dow_mon_1\b/ and $dow_mon_1 eq '') or
			($self->{parser}=~/\$week_mon_1\b/ and $week_mon_1 eq '') or
			($self->{parser}=~/\$year_100\b/ and $year_100 eq '') or
			($self->{parser}=~/\$year\b/ and $year eq '') or
			($self->{parser}=~/\$ce_year\b/ and $ce_year eq '') or
			($self->{parser}=~/\$tz_offset\b/ and $tz_offset eq '') or
			($self->{parser}=~/\$tz_olson\b/ and $tz_olson eq '') or
			($self->{parser}=~/\$timezone\b/ and $timezone eq '') or
			($self->{parser}=~/\$epoch\b/ and $epoch eq '')
		);

	# Create a timezone to work with
	if ($tz_offset) {
		$use_timezone = $tz_offset;
	}

	if ($timezone) {
		$self->local_croak("I don't recognise the timezone $timezone.") and return undef unless $ZONEMAP{$timezone};
		$self->local_croak("The timezone '$timezone' is ambiguous.") and return undef if $ZONEMAP{$timezone} eq 'Ambiguous' and not ($tz_offset or $tz_olson);
		$self->local_croak("Your timezones ('$tz_offset' and '$timezone') do not match.") and return undef if $tz_offset and $ZONEMAP{$timezone} ne 'Ambiguous' and $ZONEMAP{$timezone} != $tz_offset;
		$use_timezone = $ZONEMAP{$timezone} if $ZONEMAP{$timezone} ne 'Ambiguous';
	}

	if ($tz_olson) {
		$tz_olson = ucfirst lc $tz_olson;
		$tz_olson =~ s|([/_])(\w)|$1\U$2|;
		my $tz = DateTime::TimeZone->new( name => $tz_olson );
		$self->local_croak("I don't recognise the time zone '$tz_olson'.") and return undef unless $tz;
		$use_timezone = $set_time_zone = $tz;

	}

	$use_timezone = $self->{time_zone} unless ($use_timezone);

	print "Using timezone $use_timezone.\n" if $self->{diagnostic};

	# If there's an epoch, we're done. Just need to check all the others
	if ($epoch) {
		$epoch_dt = DateTime->from_epoch( epoch => $epoch, time_zone => $use_timezone );

		$Year      = $epoch_dt->year;
		$Month     = $epoch_dt->month;
		$Day       = $epoch_dt->day;

		$Hour      = $epoch_dt->hour;
		$Minute    = $epoch_dt->minute;
		$Second    = $epoch_dt->second;
		$Nanosecond= $epoch_dt->nanosecond;

		print $epoch_dt->strftime("Epoch: %D %T.%N\n") if $self->{diagnostic};
	}

	# Work out the year we're working with:
	if ($year_100) {
		if ($century) {
			$Year = (($century * 100) - 0) + $year_100;
		} else {
			print "No century, guessing for $year_100" if $self->{diagnostic};
			if ($year_100 >= 69 and $year_100 <= 99) {
				print "Guessed 1900s" if $self->{diagnostic};
				$Year = 1900 + $year_100;
			} else {
				print "Guessed 2000s" if $self->{diagnostic};
				$Year = 2000 + $year_100;
			}
		}
	}
	if ($year) {
		$self->local_croak("Your two year values ($year_100 and $year) do not match.") and return undef if ($Year && ($year != $Year));
		$Year = $year;
	}
	if ($ce_year) {
		$self->local_croak("Your two year values ($ce_year and $year) do not match.") and return undef if ($Year && ($ce_year != $Year));
		$Year = $ce_year;
	}
	$self->local_croak("Your year value does not match your epoch.") and return undef if $epoch_dt and $Year and $Year != $epoch_dt->year;


	# Work out which month we want
	# Month names
	if ($month_name) {
		$self->local_croak("There is no use providing a month name ($month_name) without providing a year.") and return undef unless $Year;
		my $month_count  = 0;
		my $month_number = 0;
		foreach my $month (@{$self->{_locale}->month_names}) {
			$month_count++;
			if (lc $month eq lc $month_name) {
				$month_number = $month_count;
				last;
			}
		}
		unless ($month_number) {
			my $month_count = 0;
			foreach my $month (@{$self->{_locale}->month_abbreviations}) {
				$month_count++;
				if (lc $month eq lc $month_name) {
					$month_number = $month_count;
					last;
				}
			}
		}
		unless ($month_number) {
			$self->local_croak("$month_name is not a recognised month in this locale.") and return undef;
		}
		$Month = $month_number;
	}
	if ($month) {
		$self->local_croak("There is no use providing a month without providing a year.") and return undef unless $Year;
		$self->local_croak("$month is too large to be a month of the year.") and return undef unless $month <= 12;
		$self->local_croak("Your two month values ($month_name and $month) do not match.") and return undef if $Month and $month != $Month;
		$Month = $month;
	}
	$self->local_croak("Your month value does not match your epoch.") and return undef if $epoch_dt and $Month and $Month != $epoch_dt->month;
	if ($doy) {
		$self->local_croak("There is no use providing a day of the year without providing a year.") and return undef unless $Year;
		$doy_dt = ($DateTime::VERSION > 0.12)
			? DateTime->from_day_of_year(year=>$Year, day_of_year=>$doy, time_zone => $use_timezone)
			: DateTime->new(year=>$Year, day=>$doy, time_zone => $use_timezone);

		my $month = $doy_dt->month;
		$self->local_croak("Your day of the year ($doy - in ".$doy_dt->month_name.") is not in your month ($Month)") and return undef if $Month and $month != $Month;
		$Month = $month;
	}
	$self->local_croak("Your day of the year does not match your epoch.") and return undef if $epoch_dt and $doy_dt and $doy_dt->doy != $epoch_dt->doy;


	# Day of the month
	$self->local_croak("$day is too large to be a day of the month.") and return undef unless $day <= 31;
	$self->local_croak("Your day of the month ($day) does not match your day of the year.") and return undef if $doy_dt and $day and $day != $doy_dt->day;
	$Day = ($day)
		? $day
		: ($doy_dt)
			? $doy_dt->day
			: '';
	if ($Day) {
		$self->local_croak("There is no use providing a day without providing a month and year.") and return undef unless $Year and $Month;
		my $dt = DateTime->new(year=>$Year, month=>$Month, day=>$Day, hour=>12, time_zone => $use_timezone);
		$self->local_croak("There is no day $Day in $dt->month_name, $Year") and return undef
			unless $dt->month == $Month;
	}
	$self->local_croak("Your day of the month does not match your epoch.") and return undef if $epoch_dt and $Day and $Day != $epoch_dt->day;


	# Hour of the day
	$self->local_croak("$hour_24 is too large to be an hour of the day.") and return undef unless $hour_24 <= 23; #OK so leap seconds will break!
	$self->local_croak("$hour_12 is too large to be an hour of the day.") and return undef unless $hour_12 <= 12;
	$self->local_croak("You must specify am or pm for 12 hour clocks ($hour_12|$ampm).") and return undef if ($hour_12 && (! $ampm));
    ($Am, $Pm) = @{$self->{_locale}->am_pms};
	if (lc $ampm eq lc $Pm) {
		if ($hour_12) {
			$hour_12 += 12 if $hour_12 and $hour_12 != 12;
		}
		$self->local_croak("Your am/pm value ($ampm) does not match your hour ($hour_24)") and return undef if $hour_24 and $hour_24 < 12;
	} elsif (lc $ampm eq lc $Am) {
		if ($hour_12) {
			$hour_12 = 0 if $hour_12 == 12;
		}
		$self->local_croak("Your am/pm value ($ampm) does not match your hour ($hour_24)") and return undef if $hour_24 >= 12;
	}
	if ($hour_12 and $hour_24) {
		$self->local_croak("You have specified mis-matching 12 and 24 hour clock information") and return undef unless $hour_12 == $hour_24;
		$Hour = $hour_24;
	} elsif ($hour_12) {
		$Hour = $hour_12;
	} elsif ($hour_24) {
		$Hour = $hour_24;
	}
	$self->local_croak("Your hour does not match your epoch.") and return undef if $epoch_dt and $Hour and $Hour != $epoch_dt->hour;
	print "Set hour to $Hour.\n" if $self->{diagnostic};

	# Minutes
	$self->local_croak("$minute is too large to be a minute.") and return undef unless $minute <= 59;
	$Minute = $minute;
	$self->local_croak("Your minute does not match your epoch.") and return undef if $epoch_dt and $Minute and $Minute != $epoch_dt->minute;
	print "Set minute to $Minute.\n" if $self->{diagnostic};


	# Seconds
	$self->local_croak("$second is too large to be a second.") and return undef unless $second <= 59; #OK so leap seconds will break!
	$Second = $second;
	$self->local_croak("Your second does not match your epoch.") and return undef if $epoch_dt and $Second and $Second != $epoch_dt->second;
	print "Set second to $Second.\n" if $self->{diagnostic};


	# Nanoeconds
	$self->local_croak("$nanosecond is too large to be a nanosecond.") and return undef unless length($nanosecond) <= 9;
	$Nanosecond = $nanosecond;
	$Nanosecond .= '0' while length($Nanosecond) < 9;
#	Epoch doesn't return nanoseconds
#	croak "Your nanosecond does not match your epoch." if $epoch_dt and $Nanosecond and $Nanosecond != $epoch_dt->nanosecond;
	print "Set nanosecond to $Nanosecond.\n" if $self->{diagnostic};

    my $potential_return = DateTime->new(
    	year		=> ($Year		|| 1),
    	month		=> ($Month		|| 1),
    	day			=> ($Day		|| 1),

    	hour		=> ($Hour		|| 0),
    	minute		=> ($Minute     || 0),
    	second		=> ($Second     || 0),
    	nanosecond	=> ($Nanosecond || 0),

    	locale      =>	$self->{_locale},
    	time_zone	=>	$use_timezone,
	);

	$self->local_croak("Your day of the week ($dow_mon_1) does not match the date supplied: ".$potential_return->ymd) and return undef if $dow_mon_1 and $potential_return->dow != $dow_mon_1;

	$self->local_croak("Your day of the week ($dow_sun_0) does not match the date supplied: ".$potential_return->ymd) and return undef if $dow_sun_0 and ($potential_return->dow % 7) != $dow_sun_0;

	if ($dow_name) {
		my $dow_count  = 0;
		my $dow_number = 0;
		foreach my $dow (@{$self->{_locale}->day_names}) {
			$dow_count++;
			if (lc $dow eq lc $dow_name) {
				$dow_number = $dow_count;
				last;
			}
		}
		unless ($dow_number) {
			my $dow_count = 0;
			foreach my $dow (@{$self->{_locale}->day_abbreviations}) {
				$dow_count++;
				if (lc $dow eq lc $dow_name) {
					$dow_number = $dow_count;
					last;
				}
			}
		}
		unless ($dow_number) {
			$self->local_croak("$dow_name is not a recognised day in this locale.") and return undef;
		}
		$self->local_croak("Your day of the week ($dow_name) does not match the date supplied: ".$potential_return->ymd) and return undef if $dow_number and $potential_return->dow != $dow_number;
	}

	$self->local_croak("Your week number ($week_sun_0) does not match the date supplied: ".$potential_return->ymd) and return undef if $week_sun_0 and $potential_return->strftime('%U') != $week_sun_0;
	$self->local_croak("Your week number ($week_mon_1) does not match the date supplied: ".$potential_return->ymd) and return undef if $week_mon_1 and $potential_return->strftime('%W') != $week_mon_1;
	$self->local_croak("Your ISO week year ($iso_week_year) does not match the date supplied: ".$potential_return->ymd) and return undef if $iso_week_year and $potential_return->strftime('%G') != $iso_week_year;
	$self->local_croak("Your ISO week year ($iso_week_year_100) does not match the date supplied: ".$potential_return->ymd) and return undef if $iso_week_year_100 and $potential_return->strftime('%g') != $iso_week_year_100;

	# Move into the timezone in the object - if there is one
	print "Potential Datetime: " . $potential_return->strftime("%F %T %z %Z") . "\n" if $self->{diagnostic};
	print "Setting timezone: " . $self->{set_time_zone} . "\n" if $self->{diagnostic};
	if ($self->{set_time_zone}) {
		$potential_return->set_time_zone($self->{set_time_zone});
	} elsif ($set_time_zone) {
		$potential_return->set_time_zone($set_time_zone);
	}
	print "Actual Datetime: " . $potential_return->strftime("%F %T %z %Z") . "\n" if $self->{diagnostic};

	return $potential_return;
}

sub parse_duration {
    croak "DateTime::Format::Strptime doesn't do durations.";
}

sub format_datetime {
    my ( $self, $dt ) = @_;
    my $pattern = $self->pattern;
    $pattern =~ s/%O/$dt->time_zone->name/eg;
	return $dt->strftime($pattern);
}

sub format_duration {
    croak "DateTime::Format::Strptime doesn't do durations.";
}



sub _build_parser {
	my $self = shift;
	my $regex = my $field_list = shift;
	my @fields = $field_list =~ m/(%\{\w+\}|%\d*.)/g;
	$field_list = join('',@fields);

	my $tempdt = DateTime->now(); # Created just so we can do $tempdt->can(..)

	# Locale-ize the parser
    my $ampm_list = join('|', @{$self->{_locale}->am_pms});
	$ampm_list .= '|' . lc $ampm_list;

	my $default_date_format = $self->{_locale}->default_date_format;
	my @locale_format = $default_date_format =~ m/(%\{\w+\}|%\d*.)/g;
	$default_date_format = join('',@locale_format);

	my $default_time_format = $self->{_locale}->default_time_format;
	@locale_format = $default_time_format =~ m/(%\{\w+\}|%\d*.)/g;
	$default_time_format = join('',@locale_format);

	my $default_datetime_format = $self->{_locale}->default_datetime_format;
	@locale_format = $default_datetime_format =~ m/(%\{\w+\}|%\d*.)/g;
	$default_datetime_format = join('',@locale_format);

	print "Date format: $default_date_format\nTime format: $default_time_format\nDatetime format: $default_datetime_format\n" if $self->{diagnostic};

	$regex =~ s/%%/ovnksdjhvniurnvkjsdhfbngkjsdbnhuyw678rhiuwf/g;
	$field_list =~ s/%%/ovnksdjhvniurnvkjsdhfbngkjsdbnhuyw678rhiuwf/g;

	$regex =~ s/%c/$self->{_locale}->default_datetime_format/eg;
	$field_list =~ s/%c/$default_datetime_format/eg;
	# %c is the locale's default datetime format.

	$regex =~ s/%x/$self->{_locale}->default_date_format/eg;
	$field_list =~ s/%x/$default_date_format/eg;
	# %x id the locale's default date format.

	$regex =~ s/%X/$self->{_locale}->default_time_format/eg;
	$field_list =~ s/%X/$default_time_format/eg;
	# %x id the locale's default time format.

	# I'm absolutely certain there's a better way to do this:
	$regex=~s|([\/\.\-])|\\$1|g;

	$regex =~ s/%T/%H:%M:%S/g;
	$field_list =~ s/%T/%H%M%S/g;
	# %T is the time as %H:%M:%S.

	$regex =~ s/%r/%I:%M:%S %p/g;
	$field_list =~ s/%r/%I%M%S%p/g;
	#is the time as %I:%M:%S %p.

	$regex =~ s/%R/%H:%M/g;
	$field_list =~ s/%R/%H%M/g;
	#is the time as %H:%M.

	$regex =~ s|%D|%m\\/%d\\/%y|g;
	$field_list =~ s|%D|%m%d%y|g;
	#is the same as %m/%d/%y.

	$regex =~ s|%F|%Y\\-%m\\-%d|g;
	$field_list =~ s|%F|%Y%m%d|g;
	#is the same as %Y-%m-%d - the ISO date format.

	my $day_re = join('|',
		map { quotemeta $_ }
			sort { length $b <=> length $a }
				grep(/\W/, @{$self->{_locale}->day_names}, @{$self->{_locale}->day_abbreviations})
	);
	$day_re .= '|' if $day_re;
	$regex =~ s/%a/($day_re\\w+)/gi;
	$field_list =~ s/%a/#dow_name#/gi;
	# %a is the day of the week, using the locale's weekday names; either the abbreviated or full name may be specified.
	# %A is the same as %a.

	my $month_re = join('|',
		map { quotemeta $_ }
			sort { length $b <=> length $a }
				grep(/\s/, @{$self->{_locale}->month_names}, @{$self->{_locale}->month_abbreviations})
	);
	$month_re .= '|' if $month_re;
	$regex =~ s/%[bBh]/($month_re\\S+)/g;
	$field_list =~ s/%[bBh]/#month_name#/g;
	#is the month, using the locale's month names; either the abbreviated or full name may be specified.
	# %B is the same as %b.
	# %h is the same as %b.

	#s/%c//g;
	#is replaced by the locale's appropriate date and time representation.

	$regex =~ s/%C/([\\d ]?\\d)/g;
	$field_list =~ s/%C/#century#/g;
	#is the century number [0,99]; leading zeros are permitted by not required.

	$regex =~ s/%[de]/([\\d ]?\\d)/g;
	$field_list =~ s/%[de]/#day#/g;
	#is the day of the month [1,31]; leading zeros are permitted but not required.
	#%e is the same as %d.

	$regex =~ s/%[Hk]/([\\d ]?\\d)/g;
	$field_list =~ s/%[Hk]/#hour_24#/g;
	#is the hour (24-hour clock) [0,23]; leading zeros are permitted but not required.
	# %k is the same as %H

	$regex =~ s/%g/([\\d ]?\\d)/g;
	$field_list =~ s/%g/#iso_week_year_100#/g;
	# The year corresponding to the ISO week number, but without the century (0-99).

	$regex =~ s/%G/(\\d{4})/g;
	$field_list =~ s/%G/#iso_week_year#/g;
	# The year corresponding to the ISO week number.

	$regex =~ s/%[Il]/([\\d ]?\\d)/g;
	$field_list =~ s/%[Il]/#hour_12#/g;
	#is the hour (12-hour clock) [1-12]; leading zeros are permitted but not required.
	# %l is the same as %I.

	$regex =~ s/%j/(\\d{1,3})/g;
	$field_list =~ s/%j/#doy#/g;
	#is the day of the year [1,366]; leading zeros are permitted but not required.

	$regex =~ s/%m/([\\d ]?\\d)/g;
	$field_list =~ s/%m/#month#/g;
	#is the month number [1-12]; leading zeros are permitted but not required.

	$regex =~ s/%M/([\\d ]?\\d)/g;
	$field_list =~ s/%M/#minute#/g;
	#is the minute [0-59]; leading zeros are permitted but not required.

	$regex =~ s/%[nt]/\\s+/g;
	$field_list =~ s/%[nt]//g;
	# %n is any white space.
	# %t is any white space.

	$regex =~ s/%p/($ampm_list)/gi;
	$field_list =~ s/%p/#ampm#/gi;
	# %p is the locale's equivalent of either A.M./P.M. indicator for 12-hour clock.

	$regex =~ s/%s/(\\d+)/g;
	$field_list =~ s/%s/#epoch#/g;
	# %s is the seconds since the epoch

	$regex =~ s/%S/([\\d ]?\\d)/g;
	$field_list =~ s/%S/#second#/g;
	# %S is the seconds [0-61]; leading zeros are permitted but not required.

	$regex =~ s/%(\d*)N/($1) ? "(\\d{$1})" : "(\\d+)"/eg;
	$field_list =~ s/%\d*N/#nanosecond#/g;
	# %N is the nanoseconds (or sub seconds really)

	$regex =~ s/%U/([\\d ]?\\d)/g;
	$field_list =~ s/%U/#week_sun_0#/g;
	# %U is the week number of the year (Sunday as the first day of the week) as a decimal number [0-53]; leading zeros are permitted but not required.

	$regex =~ s/%w/([0-6])/g;
	$field_list =~ s/%w/#dow_sun_0#/g;
	# is the weekday as a decimal number [0-6], with 0 representing Sunday.

	$regex =~ s/%u/([1-7])/g;
	$field_list =~ s/%u/#dow_mon_1#/g;
	# is the weekday as a decimal number [1-7], with 1 representing Monday - a la DateTime.

	$regex =~ s/%W/([\\d ]?\\d)/g;
	$field_list =~ s/%W/#week_mon_1#/g;
	#is the week number of the year (Monday as the first day of the week) as a decimal number [0,53]; leading zeros are permitted but not required.

	$regex =~ s/%y/([\\d ]?\\d)/g;
	$field_list =~ s/%y/#year_100#/g;
	# is the year within the century. When a century is not otherwise specified, values in the range 69-99 refer to years in the twentieth century (1969 to 1999 inclusive); values in the range 0-68 refer to years in the twenty-first century (2000-2068 inclusive). Leading zeros are permitted but not required.

	$regex =~ s/%Y/(\\d{4})/g;
	$field_list =~ s/%Y/#year#/g;
	# is the year including the century (for example, 1998).

	$regex =~ s|%z|([+-]\\d{4})|g;
	$field_list =~ s/%z/#tz_offset#/g;
	# Timezone Offset.

	$regex =~ s|%Z|(\\w+)|g;
	$field_list =~ s/%Z/#timezone#/g;
	# The short timezone name.

	$regex =~ s|%O|(\\w+\\/\\w+)|g;
	$field_list =~ s/%O/#tz_olson#/g;
	# The Olson timezone name.

	$regex =~ s|%{(\w+)}|($tempdt->can($1)) ? "(.+)" : ".+"|eg;
	$field_list =~ s|(%{(\w+)})|($tempdt->can($2)) ? "#$2#" : $1 |eg;
	# Any function in DateTime.

	$regex =~ s/ovnksdjhvniurnvkjsdhfbngkjsdbnhuyw678rhiuwf/\\%/g;
	$field_list =~ s/ovnksdjhvniurnvkjsdhfbngkjsdbnhuyw678rhiuwf//g;
	# is replaced by %.
	#print $regex;

	$field_list=~s/#([a-z0-9_]+)#/\$$1, /gi;
	$field_list=~s/,\s*$//;

	return qq|($field_list) = \$time_string =~ /$regex/|;
}

# Utility functions

sub local_croak {
	my $self = $_[0];
	return &{$self->{on_error}}(@_) if ref($self->{on_error});
	croak($_[1]) if $self->{on_error} eq 'croak';
	$self->{errmsg} = $_[1];
	return ($self->{on_error} eq 'undef');
}
sub local_carp {
	my $self = $_[0];
	return &{$self->{on_error}}(@_) if ref($self->{on_error});
	carp($_[1]) if $self->{on_error} eq 'croak';
	$self->{errmsg} = $_[1];
	return ($self->{on_error} eq 'undef');
}

sub errmsg {
	$_[0]->{errmsg};
}

# Exportable functions:

sub strftime {
	my ($pattern, $dt) = @_;
	return $dt->strftime($pattern);
}

sub strptime {
	my ($pattern, $time_string) = @_;
	return DateTime::Format::Strptime->new( pattern => $pattern, on_error=>'croak' )->parse_datetime($time_string);
}


1;
__END__

=head1 NAME

DateTime::Format::Strptime - Parse and format strp and strf time patterns

=head1 SYNOPSIS

  use DateTime::Format::Strptime;

  my $Strp = new DateTime::Format::Strptime(
  				pattern     => '%T',
  				locale      => 'en_AU',
  				time_zone   => 'Australia/Melbourne',
  			);

  my $dt = $Strp->parse_datetime('23:16:42');

  $Strp->format_datetime($dt);
	# 23:16:42



  # Croak when things go wrong:
  my $Strp = new DateTime::Format::Strptime(
  				pattern 	=> '%T',
  				locale	    => 'en_AU',
  				time_zone	=> 'Australia/Melbourne',
  				on_error	=> 'croak',
  			);

  $newpattern = $Strp->pattern('%Q');
  # Unidentified token in pattern: %Q in %Q at line 34 of script.pl

  # Do something else when things go wrong:
  my $Strp = new DateTime::Format::Strptime(
  				pattern 	=> '%T',
  				locale	    => 'en_AU',
  				time_zone	=> 'Australia/Melbourne',
  				on_error	=> \&phone_police,
  			);



=head1 DESCRIPTION

This module implements most of C<strptime(3)>, the POSIX function that
is the reverse of C<strftime(3)>, for C<DateTime>. While C<strftime>
takes a C<DateTime> and a pattern and returns a string, C<strptime> takes
a string and a pattern and returns the C<DateTime> object
associated.

=head1 CONSTRUCTOR

=over 4

=item * new( pattern=>$strptime_pattern )

Creates the format object. You must specify a pattern, you can also
specify a C<time_zone> and a C<locale>. If you specify a time zone
then any resulting C<DateTime> object will be in that time zone. If you
do not specify a C<time_zone> parameter, but there is a time zone in the
string you pass to C<parse_datetime>, then the resulting C<DateTime> will
use that time zone.

You can optionally use an on_error parameter. This parameter has three
valid options:

=over 4

=item * 'undef'

(not undef, 'undef', it's a string not an undefined value)

This is the default behavior. The module will return undef whenever it
gets upset. The error can be accessed using the $object->errstr method.
This is the ideal behaviour for interactive use where a user might
provide an illegal pattern or a date that doesn't match the pattern.

=item * 'croak'

(not croak, 'croak', it's a string, not a function)

This used to be the default behaviour. The module will croak with an
error message whenever it gets upset.

=item * sub{...} or \&subname

When given a code ref, the module will call that sub when it gets upset.
The sub receives two parameters: the object and the error message. Using
these two it is possible to emulate the 'undef' behavior. (Returning a
true value causes the method to return undef. Returning a false value
causes the method to bravely continue):

sub{$_[0]->{errmsg} = $_[1]; 1},

=back

=back

=head1 METHODS

This class offers the following methods.

=over 4

=item * parse_datetime($string)

Given a string in the pattern specified in the constructor, this method
will return a new C<DateTime> object.

If given a string that doesn't match the pattern, the formatter will
croak or return undef, depending on the setting of on_error in the constructor.

=item * format_datetime($datetime)

Given a C<DateTime> object, this methods returns a string formatted in
the object's format. This method is synonymous with C<DateTime>'s
strftime method.

=item * locale($locale)

When given a locale, this method sets its locale appropriately. If
the locale is not understood, the method will croak or return undef
(depending on the setting of on_error in the constructor)

If successful this method returns the current locale. (After
processing as above).

=item * pattern($strptime_pattern)

When given a pattern, this method sets the object's pattern. If the
pattern is invalid, the method will croak or return undef (depending on
the value of the C<on_error> parameter)

If successful this method returns the current pattern. (After processing
as above)

=item * time_zone($time_zone)

When given a name, offset or C<DateTime::TimeZone> object, this method
sets the object's time zone. This effects the C<DateTime> object
returned by parse_datetime

If the time zone is invalid, the method will croak or return undef
(depending on the value of the C<on_error> parameter)

If successful this method returns the current time zone. (After processing
as above)

=item * errmsg

If the on_error behavior of the object is 'undef', error messages with
this method so you can work out why things went wrong.

This code emulates a C<$DateTime::Format::Strptime> with
the C<on_error> parameter equal to C<'croak'>:

C<$Strp->pattern($pattern) or die $DateTime::Format::Strptime::errmsg>

=back

=head1 EXPORTS

There are no methods exported by default, however the following are
available:

=over 4

=item * strptime($strptime_pattern, $string)

Given a pattern and a string this function will return a new C<DateTime>
object.

=item * strftime($strftime_pattern, $datetime)

Given a pattern and a C<DateTime> object this function will return a
formatted string.

=back

=head1 STRPTIME PATTERN TOKENS

The following tokens are allowed in the pattern string for strptime
(parse_datetime):

=over 4

=item * %%

The % character.

=item * %a or %A

The weekday name according to the current locale, in abbreviated form or
the full name.

=item * %b or %B or %h

The month name according to the current locale, in abbreviated form or
the full name.

=item * %C

The century number (0-99).

=item * %d or %e

The day of month (1-31).

=item * %D

Equivalent to %m/%d/%y. (This is the American style date, very confusing
to non-Americans, especially since %d/%m/%y is	widely used in Europe.
The ISO 8601 standard pattern is %F.)

=item * %F

Equivalent to %Y-%m-%d. (This is the ISO style date)

=item * %g

The year corresponding to the ISO week number, but without the century
(0-99).

=item * %G

The year corresponding to the ISO week number.

=item * %H

The hour (0-23).

=item * %I

The hour on a 12-hour clock (1-12).

=item * %j

The day number in the year (1-366).

=item * %m

The month number (1-12).

=item * %M

The minute (0-59).

=item * %n

Arbitrary whitespace.

=item * %N

Nanoseconds. For other sub-second values use C<%[number]N>.

=item * %p

The equivalent of AM or PM according to the locale in use. (See
L<DateTime::Locale>)

=item * %r

Equivalent to %I:%M:%S %p.

=item * %R

Equivalent to %H:%M.

=item * %s

Number of seconds since the Epoch.

=item * %S

The second (0-60; 60 may occur for leap seconds. See
L<DateTime::LeapSecond>).

=item * %t

Arbitrary whitespace.

=item * %T

Equivalent to %H:%M:%S.

=item * %U

The week number with Sunday the first day of the week (0-53). The first
Sunday of January is the first day of week 1.

=item * %u

The weekday number (1-7) with Monday = 1. This is the C<DateTime> standard.

=item * %w

The weekday number (0-6) with Sunday = 0.

=item * %W

The week number with Monday the first day of the week (0-53). The first
Monday of January is the first day of week 1.

=item * %y

The year within century (0-99). When a century is not otherwise
specified, values in the range 69-99 refer to years in the twen- tieth
century (1969-1999); values in the range 00-68 refer to years in the
twenty-first century (2000-2068).

=item * %Y

The year, including century (for example, 1991).

=item * %z

An RFC-822/ISO 8601 standard time zone specification. (For example
+1100) [See note below]

=item * %Z

The timezone name. (For example EST -- which is ambiguous) [See note
below]

=item * %O

This extended token allows the use of Olson Time Zone names to appear
in parsed strings. B<NOTE>: This pattern cannot be passed to C<DateTime>'s
C<strftime()> method, but can be passed to C<format_datetime()>.

=back

=head1 NOTES

=over 4

=item * on_error

Default behavior of this module is now to return undef on erroring.

=back

=head1 SUPPORT

Support for this module is provided via the datetime@perl.org email
list. See http://lists.perl.org/ for more details.

Alternatively, log them via the CPAN RT system via the web or email:

	bug-datetime-format-strptime@rt.cpan.org

This makes it much easier for me to track things and thus means your
problem is less likely to be neglected.

=head1 LICENSE AND COPYRIGHT

Copyright (c) Rick Measham, 2003-2005. All rights reserved.

This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

The full text of the licenses can be found in the F<LICENCE> file
included with this module.

=head1 AUTHOR

Rick Measham <rickm@cpan.org>

=head1 SEE ALSO

C<datetime@perl.org> mailing list.

http://datetime.perl.org/

L<perl>, L<DateTime>, L<DateTime::TimeZone>

=cut