package Time::Piece;

use strict;

use XSLoader ();
use Time::Seconds;
use Carp;
use Time::Local;
use Scalar::Util qw/ blessed /;

use Exporter ();

our @EXPORT = qw(
    localtime
    gmtime
);

our %EXPORT_TAGS = (
    ':override' => 'internal',
    );

our $VERSION = '1.38';

XSLoader::load( 'Time::Piece', $VERSION );

my $DATE_SEP = '-';
my $TIME_SEP = ':';
my $DATE_FORMAT = '%a, %d %b %Y %H:%M:%S %Z';
my @MON_LIST = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
my @FULLMON_LIST = qw(January February March April May June July
                      August September October November December);
my @DAY_LIST = qw(Sun Mon Tue Wed Thu Fri Sat);
my @FULLDAY_LIST = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
my $IS_WIN32 = ($^O =~ /Win32/);
my $IS_LINUX = ($^O =~ /linux/i);

my $LOCALE;

use constant {
    'c_sec' => 0,
    'c_min' => 1,
    'c_hour' => 2,
    'c_mday' => 3,
    'c_mon' => 4,
    'c_year' => 5,
    'c_wday' => 6,
    'c_yday' => 7,
    'c_isdst' => 8,
    'c_epoch' => 9,
    'c_islocal' => 10,
};

sub localtime {
    unshift @_, __PACKAGE__ unless eval { $_[0]->isa('Time::Piece') };
    my $class = shift;
    my $time  = shift;
    $time = time if (!defined $time);
    $class->_mktime($time, 1);
}

sub gmtime {
    unshift @_, __PACKAGE__ unless eval { $_[0]->isa('Time::Piece') };
    my $class = shift;
    my $time  = shift;
    $time = time if (!defined $time);
    $class->_mktime($time, 0);
}


# Check if the supplied param is either a normal array (as returned from
# localtime in list context) or a Time::Piece-like wrapper around one.
#
# We need to differentiate between an array ref that we can interrogate and
# other blessed objects (like overloaded values).
sub _is_time_struct {
    return 1 if ref($_[1]) eq 'ARRAY';
    return 1 if blessed($_[1]) && $_[1]->isa('Time::Piece');

    return 0;
}


sub new {
    my $class = shift;
    my ($time) = @_;

    my $self;

    if ($class->_is_time_struct($time)) {
        $self = $time->[c_islocal] ? $class->localtime($time) : $class->gmtime($time);
    }
    elsif (defined($time)) {
        $self = $class->localtime($time);
    }
    elsif (ref($class) && $class->isa(__PACKAGE__)) {
        $self = $class->_mktime($class->epoch, $class->[c_islocal]);
    }
    else {
        $self = $class->localtime();
    }

    return bless $self, ref($class) || $class;
}

sub parse {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my @components;

    warnings::warnif("deprecated", 
        "parse() is deprecated, use strptime() instead.");

    if (@_ > 1) {
        @components = @_;
    }
    else {
        @components = shift =~ /(\d+)$DATE_SEP(\d+)$DATE_SEP(\d+)(?:(?:T|\s+)(\d+)$TIME_SEP(\d+)(?:$TIME_SEP(\d+)))/;
        @components = reverse(@components[0..5]);
    }
    return $class->new( timelocal(@components ));
}

sub _mktime {
    my ($class, $time, $islocal) = @_;

    $class = blessed($class) || $class;

    if ($class->_is_time_struct($time)) {
        return wantarray ? @$time : bless [@$time[0..8], undef, $islocal], $class;
    }
    _tzset();
    my @time = $islocal ?
            CORE::localtime($time)
                :
            CORE::gmtime($time);
    wantarray ? @time : bless [@time, $time, $islocal], $class;
}

my %_special_exports = (
  localtime => sub { my $c = $_[0]; sub { $c->localtime(@_) } },
  gmtime    => sub { my $c = $_[0]; sub { $c->gmtime(@_)    } },
);

sub export {
  my ($class, $to, @methods) = @_;
  for my $method (@methods) {
    if (exists $_special_exports{$method}) {
      no strict 'refs';
      no warnings 'redefine';
      *{$to . "::$method"} = $_special_exports{$method}->($class);
    } else {
      $class->Exporter::export($to, $method);
    }
  }
}

sub import {
    # replace CORE::GLOBAL localtime and gmtime if passed :override
    my $class = shift;
    my %params;
    map($params{$_}++,@_,@EXPORT);
    if (delete $params{':override'}) {
        $class->export('CORE::GLOBAL', keys %params);
    }
    else {
        $class->export(scalar caller, keys %params);
    }
}

## Methods ##

sub sec {
    my $time = shift;
    $time->[c_sec];
}

*second = \&sec;

sub min {
    my $time = shift;
    $time->[c_min];
}

*minute = \&min;

sub hour {
    my $time = shift;
    $time->[c_hour];
}

sub mday {
    my $time = shift;
    $time->[c_mday];
}

*day_of_month = \&mday;

sub mon {
    my $time = shift;
    $time->[c_mon] + 1;
}

sub _mon {
    my $time = shift;
    $time->[c_mon];
}

sub month {
    my $time = shift;
    if (@_) {
        return $_[$time->[c_mon]];
    }
    elsif (@MON_LIST) {
        return $MON_LIST[$time->[c_mon]];
    }
    else {
        return $time->strftime('%b');
    }
}

*monname = \&month;

sub fullmonth {
    my $time = shift;
    if (@_) {
        return $_[$time->[c_mon]];
    }
    elsif (@FULLMON_LIST) {
        return $FULLMON_LIST[$time->[c_mon]];
    }
    else {
        return $time->strftime('%B');
    }
}

sub year {
    my $time = shift;
    $time->[c_year] + 1900;
}

sub _year {
    my $time = shift;
    $time->[c_year];
}

sub yy {
    my $time = shift;
    my $res = $time->[c_year] % 100;
    return $res > 9 ? $res : "0$res";
}

sub wday {
    my $time = shift;
    $time->[c_wday] + 1;
}

sub _wday {
    my $time = shift;
    $time->[c_wday];
}

*day_of_week = \&_wday;

sub wdayname {
    my $time = shift;
    if (@_) {
        return $_[$time->[c_wday]];
    }
    elsif (@DAY_LIST) {
        return $DAY_LIST[$time->[c_wday]];
    }
    else {
        return $time->strftime('%a');
    }
}

*day = \&wdayname;

sub fullday {
    my $time = shift;
    if (@_) {
        return $_[$time->[c_wday]];
    }
    elsif (@FULLDAY_LIST) {
        return $FULLDAY_LIST[$time->[c_wday]];
    }
    else {
        return $time->strftime('%A');
    }
}

sub yday {
    my $time = shift;
    $time->[c_yday];
}

*day_of_year = \&yday;

sub isdst {
    my $time = shift;
    return 0 unless $time->[c_islocal];
    # Calculate dst based on current TZ
    if ( $time->[c_isdst] == -1 ) {
        $time->[c_isdst] = ( CORE::localtime( $time->epoch ) )[-1];
    }
    return $time->[c_isdst];
}

*daylight_savings = \&isdst;

# Thanks to Tony Olekshy <olekshy@cs.ualberta.ca> for this algorithm
sub tzoffset {
    my $time = shift;

    return Time::Seconds->new(0) unless $time->[c_islocal];

    my $epoch = $time->epoch;

    my $j = sub {

        my ($s,$n,$h,$d,$m,$y) = @_; $m += 1; $y += 1900;

        $time->_jd($y, $m, $d, $h, $n, $s);

    };

    # Compute floating offset in hours.
    #
    # Note use of crt methods so the tz is properly set...
    # See: http://perlmonks.org/?node_id=820347
    my $delta = 24 * ($j->(_crt_localtime($epoch)) - $j->(_crt_gmtime($epoch)));

    # Return value in seconds rounded to nearest minute.
    return Time::Seconds->new( int($delta * 60 + ($delta >= 0 ? 0.5 : -0.5)) * 60 );
}

sub epoch {
    my $time = shift;
    if (defined($time->[c_epoch])) {
        return $time->[c_epoch];
    }
    else {
        my $epoch = $time->[c_islocal] ?
          timelocal(@{$time}[c_sec .. c_mon], $time->[c_year]+1900)
          :
          timegm(@{$time}[c_sec .. c_mon], $time->[c_year]+1900);
        $time->[c_epoch] = $epoch;
        return $epoch;
    }
}

sub hms {
    my $time = shift;
    my $sep = @_ ? shift(@_) : $TIME_SEP;
    sprintf("%02d$sep%02d$sep%02d", $time->[c_hour], $time->[c_min], $time->[c_sec]);
}

*time = \&hms;

sub ymd {
    my $time = shift;
    my $sep = @_ ? shift(@_) : $DATE_SEP;
    sprintf("%d$sep%02d$sep%02d", $time->year, $time->mon, $time->[c_mday]);
}

*date = \&ymd;

sub mdy {
    my $time = shift;
    my $sep = @_ ? shift(@_) : $DATE_SEP;
    sprintf("%02d$sep%02d$sep%d", $time->mon, $time->[c_mday], $time->year);
}

sub dmy {
    my $time = shift;
    my $sep = @_ ? shift(@_) : $DATE_SEP;
    sprintf("%02d$sep%02d$sep%d", $time->[c_mday], $time->mon, $time->year);
}

sub datetime {
    my $time = shift;
    my %seps = (date => $DATE_SEP, T => 'T', time => $TIME_SEP, @_);
    return join($seps{T}, $time->date($seps{date}), $time->time($seps{time}));
}



# Julian Day is always calculated for UT regardless
# of local time
sub julian_day {
    my $time = shift;
    # Correct for localtime
    $time = $time->gmtime( $time->epoch ) if $time->[c_islocal];

    # Calculate the Julian day itself
    my $jd = $time->_jd( $time->year, $time->mon, $time->mday,
                        $time->hour, $time->min, $time->sec);

    return $jd;
}

# MJD is defined as JD - 2400000.5 days
sub mjd {
    return shift->julian_day - 2_400_000.5;
}

# Internal calculation of Julian date. Needed here so that
# both tzoffset and mjd/jd methods can share the code
# Algorithm from Hatcher 1984 (QJRAS 25, 53-55), and
#  Hughes et al, 1989, MNRAS, 238, 15
# See: http://adsabs.harvard.edu/cgi-bin/nph-bib_query?bibcode=1989MNRAS.238.1529H&db_key=AST
# for more details

sub _jd {
    my $self = shift;
    my ($y, $m, $d, $h, $n, $s) = @_;

    # Adjust input parameters according to the month
    $y = ( $m > 2 ? $y : $y - 1);
    $m = ( $m > 2 ? $m - 3 : $m + 9);

    # Calculate the Julian Date (assuming Julian calendar)
    my $J = int( 365.25 *( $y + 4712) )
      + int( (30.6 * $m) + 0.5)
        + 59
          + $d
            - 0.5;

    # Calculate the Gregorian Correction (since we have Gregorian dates)
    my $G = 38 - int( 0.75 * int(49+($y/100)));

    # Calculate the actual Julian Date
    my $JD = $J + $G;

    # Modify to include hours/mins/secs in floating portion.
    return $JD + ($h + ($n + $s / 60) / 60) / 24;
}

sub week {
    my $self = shift;

    my $J  = $self->julian_day;
    # Julian day is independent of time zone so add on tzoffset
    # if we are using local time here since we want the week day
    # to reflect the local time rather than UTC
    $J += ($self->tzoffset/(24*3600)) if $self->[c_islocal];

    # Now that we have the Julian day including fractions
    # convert it to an integer Julian Day Number using nearest
    # int (since the day changes at midday we convert all Julian
    # dates to following midnight).
    $J = int($J+0.5);

    use integer;
    my $d4 = ((($J + 31741 - ($J % 7)) % 146097) % 36524) % 1461;
    my $L  = $d4 / 1460;
    my $d1 = (($d4 - $L) % 365) + $L;
    return $d1 / 7 + 1;
}

sub _is_leap_year {
    my $year = shift;
    return (($year %4 == 0) && !($year % 100 == 0)) || ($year % 400 == 0)
               ? 1 : 0;
}

sub is_leap_year {
    my $time = shift;
    my $year = $time->year;
    return _is_leap_year($year);
}

my @MON_LAST = qw(31 28 31 30 31 30 31 31 30 31 30 31);

sub month_last_day {
    my $time = shift;
    my $year = $time->year;
    my $_mon = $time->_mon;
    return $MON_LAST[$_mon] + ($_mon == 1 ? _is_leap_year($year) : 0);
}

my $strftime_trans_map = {
    'c' => sub {
        my ( $format ) = @_;
        if($LOCALE->{PM} && $LOCALE->{AM}){
            $format =~ s/%c/%a %d %b %Y %I:%M:%S %p/;
        }
        else{
            $format =~ s/%c/%a %d %b %Y %H:%M:%S/;
        }
        return $format;
    },
    'e' => sub {
        my ( $format, $time ) = @_;
        my $day = sprintf( "%2d", $time->[c_mday] );
        $format =~ s/%e/$day/ if $IS_WIN32;
        return $format;
    },
    'D' => sub {
        my ( $format ) = @_;
        $format =~ s/%D/%m\/%d\/%y/;
        return $format;
    },
    'F' => sub {
        my ( $format ) = @_;
        $format =~ s/%F/%Y-%m-%d/;
        return $format;
    },
    'k' => sub {
        my ( $format, $time ) = @_;
        my $hr = sprintf( "%2d", $time->[c_hour] );
        $format =~ s/%k/$hr/;
        return $format;
    },
    'l' => sub {
        my ( $format, $time ) = @_;
        my $hr = $time->[c_hour] > 12 ? $time->[c_hour] - 12 : $time->[c_hour];
        $hr = 12 unless $hr;
        $hr = sprintf( "%2d", $hr );
        $format =~ s/%l/$hr/;
        return $format;
    },
    'P' => sub {
        my ( $format ) = @_;
        # %P seems to be linux only
        $format =~ s/%P/%p/ unless $IS_LINUX;
        return $format;
    },
    'r' => sub {
        my ( $format ) = @_;
        if($LOCALE->{PM} && $LOCALE->{AM}){
            $format =~ s/%r/%I:%M:%S %p/;
        }
        else{
            $format =~ s/%r/%H:%M:%S/;
        }
        return $format;
    },
    'R' => sub {
        my ( $format ) = @_;
        $format =~ s/%R/%H:%M/;
        return $format;
    },
    's' => sub {
        #%s not portable if time parts are from gmtime since %s will
        #cause a call to native mktime (and thus uses local TZ)
        my ( $format, $time ) = @_;
        my $e = $time->epoch();
        $format =~ s/%s/$e/;
        return $format;
    },
    'T' => sub {
        my ( $format ) = @_;
        $format =~ s/%T/%H:%M:%S/ if $IS_WIN32;
        return $format;
    },
    'u' => sub {
        my ( $format ) = @_;
        $format =~ s/%u/%w/ if $IS_WIN32;
        return $format;
    },
    'V' => sub {
        my ( $format, $time ) = @_;
        my $week = sprintf( "%02d", $time->week() );
        $format =~ s/%V/$week/ if $IS_WIN32;
        return $format;
    },
    'x' => sub {
        my ( $format ) = @_;
        $format =~ s/%x/%a %d %b %Y/;
        return $format;
    },
    'X' => sub {
        my ( $format ) = @_;
        if($LOCALE->{PM} && $LOCALE->{AM}){
            $format =~ s/%X/%I:%M:%S %p/;
        }
        else{
            $format =~ s/%X/%H:%M:%S/;
        }
        return $format;
    },
    'z' => sub {    #%[zZ] not portable if time parts are from gmtime
        my ( $format, $time ) = @_;
        $format =~ s/%z/+0000/ if not $time->[c_islocal];
        return $format;
    },
    'Z' => sub {
        my ( $format, $time ) = @_;
        $format =~ s/%Z/UTC/ if not $time->[c_islocal];
        return $format;
    },
};

sub strftime {
    my $time = shift;
    my $format = @_ ? shift(@_) : $DATE_FORMAT;
    $format = _translate_format($format, $strftime_trans_map, $time);

    return $format unless $format =~ /%/; #if translate removes everything

    return _strftime($format, $time->epoch, $time->[c_islocal]);
}

sub strptime {
    my $time   = shift;
    my $string = shift;
    my $format;
    my $opts;

    if ( @_ >= 2 && blessed( $_[1] ) && $_[1]->isa('Time::Piece') ) {
        # $string, $format, $time_piece_object
        $format = shift;
        $opts   = { defaults => shift };
    } elsif ( @_ && blessed( $_[0] ) && $_[0]->isa('Time::Piece') ) {
        # $string, $time_piece_object
        $opts   = { defaults => shift };
        $format = $DATE_FORMAT;
    } elsif ( @_ >= 2 && ref( $_[1] ) eq 'HASH' ) {
        # $string, $format, {options => ...}
        $format = shift;
        $opts   = shift;
    } elsif ( @_ && ref( $_[0] ) eq 'HASH' ) {
        # $string, {options => ...}
        $opts   = shift;
        $format = @_ ? shift : $DATE_FORMAT;
    } else {
        $format = @_ ? shift : $DATE_FORMAT;
    }

    my $islocal  = ( ref($time) ? $time->[c_islocal] : 0 );
    my $locales  = $LOCALE || &Time::Piece::_default_locale();
    my $defaults = [];

    if ($opts) {
        # Validate and process defaults if provided
        if ( exists $opts->{defaults} ) {
            if ( ref( $opts->{defaults} ) eq 'ARRAY' ) {
                $defaults = $opts->{defaults};
                unless ( @{ $opts->{defaults} } >= 8 ) {
                    croak("defaults array must have at least 8 elements!");
                }
            } elsif ( ref( $opts->{defaults} ) eq 'HASH' ) {

                ( exists $opts->{defaults}{$_} )
                  ? push( @{$defaults}, $opts->{defaults}{$_} )
                  : push( @{$defaults}, undef )
                  for qw/sec min hour mday mon year wday yday/;

                if ( defined $defaults->[c_year]
                    && $defaults->[c_year] >= 1000 ) {
                    $defaults->[c_year] -= 1900;
                }

            } elsif ( blessed( $opts->{defaults} )
                && $opts->{defaults}->isa('Time::Piece') ) {
                # Extract time components from Time::Piece object
                $defaults = [ @{ $opts->{defaults} }[ c_sec .. c_yday ] ];
                $islocal  = $opts->{defaults}[c_islocal];
            } else {
                croak("defaults must be an array reference, hash reference, or Time::Piece object");
            }
        }

        # Check for forced islocal
        if ( exists $opts->{islocal} && $opts->{islocal} ) {
            $islocal = 1;
        }
    }

    my @vals = _strptime( $string, $format, $islocal, $locales, $defaults );

    return scalar $time->_mktime( \@vals, $islocal );
}

sub day_list {
    shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); # strip first if called as a method
    my @old = @DAY_LIST;
    if (@_) {
        @DAY_LIST = @_;
        &Time::Piece::_default_locale();
    }
    return @old;
}

sub mon_list {
    shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); # strip first if called as a method
    my @old = @MON_LIST;
    if (@_) {
        @MON_LIST = @_;
        &Time::Piece::_default_locale();
    }
    return @old;
}

sub time_separator {
    shift if ref($_[0]) && $_[0]->isa(__PACKAGE__);
    my $old = $TIME_SEP;
    if (@_) {
        $TIME_SEP = $_[0];
    }
    return $old;
}

sub date_separator {
    shift if ref($_[0]) && $_[0]->isa(__PACKAGE__);
    my $old = $DATE_SEP;
    if (@_) {
        $DATE_SEP = $_[0];
    }
    return $old;
}

use overload '""' => \&cdate,
             'cmp' => \&str_compare,
             'fallback' => undef;

sub cdate {
    my $time = shift;
    if ($time->[c_islocal]) {
        return scalar(CORE::localtime($time->epoch));
    }
    else {
        return scalar(CORE::gmtime($time->epoch));
    }
}

sub str_compare {
    my ($lhs, $rhs, $reverse) = @_;

    if (blessed($rhs) && $rhs->isa('Time::Piece')) {
        $rhs = "$rhs";
    }
    return $reverse ? $rhs cmp $lhs->cdate : $lhs->cdate cmp $rhs;
}

use overload
        '-' => \&subtract,
        '+' => \&add;

sub subtract {
    my $time = shift;
    my $rhs = shift;

    if (shift)
    {
	# SWAPED is set (so someone tried an expression like NOTDATE - DATE).
	# Imitate Perl's standard behavior and return the result as if the
	# string $time resolves to was subtracted from NOTDATE.  This way,
	# classes which override this one and which have a stringify function
	# that resolves to something that looks more like a number don't need
	# to override this function.
	return $rhs - "$time";
    }

    #TODO: handle math with objects where one is DST and the other isn't
    #so either convert both to a gmtime object, subtract and then convert to localtime object (would have to add ->to_gmt and ->to_local methods)
    #or check the tzoffset on each object, if they are different, add in the differing seconds.
    if (blessed($rhs) && $rhs->isa('Time::Piece')) {
        return Time::Seconds->new($time->epoch - $rhs->epoch);
    }
    else {
        # rhs is seconds.
        return $time->_mktime(($time->epoch - $rhs), $time->[c_islocal]);
    }
}

sub add {
    my $time = shift;
    my $rhs = shift;

    return $time->_mktime(($time->epoch + $rhs), $time->[c_islocal]);
}

use overload
        '<=>' => \&compare;

sub get_epochs {
    my ($lhs, $rhs, $reverse) = @_;
    unless (blessed($rhs) && $rhs->isa('Time::Piece')) {
        $rhs = $lhs->new($rhs);
    }
    if ($reverse) {
        return $rhs->epoch, $lhs->epoch;
    }
    return $lhs->epoch, $rhs->epoch;
}

sub compare {
    my ($lhs, $rhs) = get_epochs(@_);
    return $lhs <=> $rhs;
}

sub add_months {
    my ($time, $num_months) = @_;

    croak("add_months requires a number of months") unless defined($num_months);

    my $final_month = $time->_mon + $num_months;
    my $num_years = 0;
    if ($final_month > 11 || $final_month < 0) {
        # these two ops required because we have no POSIX::floor and don't
        # want to load POSIX.pm
        if ($final_month < 0 && $final_month % 12 == 0) {
            $num_years = int($final_month / 12) + 1;
        }
        else {
            $num_years = int($final_month / 12);
        }
        $num_years-- if ($final_month < 0);

        $final_month = $final_month % 12;
    }

    my @vals = _mini_mktime($time->sec, $time->min, $time->hour,
                            $time->mday, $final_month, $time->year - 1900 + $num_years);
    # warn(sprintf("got %d vals: %d-%d-%d %d:%d:%d [%d]\n", scalar(@vals), reverse(@vals), $time->[c_islocal]));
    return scalar $time->_mktime(\@vals, $time->[c_islocal]);
}

sub add_years {
    my ($time, $years) = @_;
    $time->add_months($years * 12);
}

sub truncate {
    my ($time, %params) = @_;
    return $time unless exists $params{to};
    #if ($params{to} eq 'week') { return $time->_truncate_week; }
    my %units = (
        second   => 0,
        minute   => 1,
        hour     => 2,
        day      => 3,
        month    => 4,
        quarter  => 5,
        year     => 5
    );
    my $to = $units{$params{to}};
    croak "Invalid value of 'to' parameter: $params{to}" unless defined $to;
    my $start_month = 0;
    if ($params{to} eq 'quarter') {
        $start_month = int( $time->_mon / 3 ) * 3;
    }
    my @down_to = (0, 0, 0, 1, $start_month, $time->year);
    return $time->_mktime([@down_to[0..$to-1], @$time[$to..c_isdst]],
        $time->[c_islocal]);
}

my $_format_cache = {};

#Given a format and a translate map, replace format flags in
#accordance with the logic from the translation map subroutines
sub _translate_format {
    my ( $format, $trans_map, $time ) = @_;
    my $bad_flags = $IS_WIN32 ? qr/%([eklsVzZ])/ : qr/%([klszZ])/;
    my $can_cache = ($format !~ $bad_flags) ? 1 : 0;

    if ( $can_cache && exists $_format_cache->{$format} ){
        return $_format_cache->{$format};
    }

    $format =~ s/%%/\e\e/g; #escape the escape
    my $lexer = _build_format_lexer($format);

	while(my $flag = $lexer->() ){
        next unless exists $trans_map->{$flag};
		$format = $trans_map->{$flag}($format, $time);
	}

    $format =~ s/\e\e/%%/g;
    $_format_cache->{$_[0]} = $format if $can_cache;

    return $format;
}

sub _build_format_lexer {
    my $format = shift();

    #Higher Order Perl p.359 (or thereabouts)
    return sub {
        LABEL: {
        return $1 if $format =~ m/\G%([a-zA-Z])/gc; #return single char flags

        redo LABEL if $format =~ m/\G(.)/gc;
        return; #return at empty string
        }
    };
}

sub use_locale {
    #get locale month/day names from posix strftime (from Piece.xs)
    my $locales = _get_localization();

    #If AM and PM are the same, set both to ''
    if (   !$locales->{PM}
        || !$locales->{AM}
        || ( $locales->{PM} eq $locales->{AM} ) )
    {
        $locales->{PM} = '';
        $locales->{AM} = '';
    }

    if (   !$locales->{pm}
        || !$locales->{am}
        || ( $locales->{pm} eq $locales->{am} ) )
    {
        $locales->{pm} = lc $locales->{PM};
        $locales->{am} = lc $locales->{AM};
    }

    #should probably figure out how to get a
    #region specific format for %c someday
    $locales->{c_fmt} = '';

    #Set globals. If anything is
    #weird just use original
    if( @{$locales->{weekday}} < 7 ){
        @{$locales->{weekday}} = @FULLDAY_LIST;
    }
    else {
        @FULLDAY_LIST = @{$locales->{weekday}};
    }

    if( @{$locales->{wday}} < 7 ){
        @{$locales->{wday}} = @DAY_LIST;
    }
    else {
        @DAY_LIST = @{$locales->{wday}};
    }

    if( @{$locales->{month}} < 12 ){
        @{$locales->{month}} = @FULLMON_LIST;
    }else {
        @FULLMON_LIST = @{$locales->{month}};
    }

    if( @{$locales->{mon}} < 12 ){
        @{$locales->{mon}} = @MON_LIST;
    }
    else{
        @MON_LIST= @{$locales->{mon}};
    }

    $LOCALE = $locales;
}

#$Time::Piece::LOCALE is used by strptime and thus needs to be
#in sync with what ever users change to via day_list() and mon_list().
#Should probably deprecate this use of global state, but oh well...
sub _default_locale {
    my $locales = {};

    @{ $locales->{weekday} } = @FULLDAY_LIST;
    @{ $locales->{wday} }    = @DAY_LIST;
    @{ $locales->{month} }   = @FULLMON_LIST;
    @{ $locales->{mon} }     = @MON_LIST;

    $locales->{PM}    = 'PM';
    $locales->{AM}    = 'AM';
    $locales->{pm}    = 'pm';
    $locales->{am}    = 'am';
    $locales->{c_fmt} = '';

    $LOCALE = $locales;
}

sub _locale {
    return $LOCALE;
}


1;
__END__

=head1 NAME

Time::Piece - Object Oriented time objects

=head1 SYNOPSIS

    use Time::Piece;

    my $t = localtime;
    print "Time is $t\n";
    print "Year is ", $t->year, "\n";

=head1 DESCRIPTION

This module replaces the standard C<localtime> and C<gmtime> functions with
implementations that return objects. It does so in a backwards
compatible manner, so that using localtime/gmtime in the way documented
in perlfunc will still return what you expect.

The module actually implements most of an interface described by
Larry Wall on the perl5-porters mailing list here:
L<https://www.nntp.perl.org/group/perl.perl5.porters/2000/01/msg5283.html>


After importing this module, when you use C<localtime> or C<gmtime> in a scalar
context, rather than getting an ordinary scalar string representing the
date and time, you get a C<Time::Piece> object, whose stringification happens
to produce the same effect as the C<localtime> and C<gmtime> functions.

The primary way to create Time::Piece objects is through the C<localtime> and
C<gmtime> functions. There is also a C<new()> constructor which is the same as
C<localtime()>, except when passed a Time::Piece object, in which case it's a
copy constructor.

=head1 Public Methods

The following methods are available on the object:

=head2 Time Components

    $t->sec                 # also available as $t->second
    $t->min                 # also available as $t->minute
    $t->hour                # 24 hour

=head2 Date Components

    $t->mday                # also available as $t->day_of_month
    $t->mon                 # 1 = January
    $t->_mon                # 0 = January
    $t->year                # based at 0 (year 0 AD is, of course 1 BC)
    $t->_year               # year minus 1900
    $t->yy                  # 2 digit year

=head2 Day and Month Names

    $t->monname             # Feb
    $t->month               # same as $t->monname
    $t->fullmonth           # February
    $t->wday                # 1 = Sunday
    $t->_wday               # 0 = Sunday
    $t->day_of_week         # 0 = Sunday
    $t->wdayname            # Tue
    $t->day                 # same as wdayname
    $t->fullday             # Tuesday

=head2 Formatted Date/Time Output

    $t->hms                 # 12:34:56
    $t->hms(".")            # 12.34.56
    $t->time                # same as $t->hms
    $t->ymd                 # 2000-02-29
    $t->date                # same as $t->ymd
    $t->mdy                 # 02-29-2000
    $t->mdy("/")            # 02/29/2000
    $t->dmy                 # 29-02-2000
    $t->dmy(".")            # 29.02.2000
    $t->datetime            # 2000-02-29T12:34:56 (ISO 8601)
    $t->cdate               # Tue Feb 29 12:34:56 2000
    "$t"                    # same as $t->cdate
    $t->strftime(FORMAT)    # same as POSIX::strftime (without the overhead
                            # of the full POSIX extension)
    $t->strftime()          # "Tue, 29 Feb 2000 12:34:56 GMT"

=head2 Epoch and Calendar Calculations

    $t->epoch               # seconds since the epoch
    $t->julian_day          # number of days since Julian period began
    $t->mjd                 # modified Julian date (JD-2400000.5 days)
    $t->week                # week number (ISO 8601)
    $t->yday                # also available as $t->day_of_year, 0 = Jan 01

=head2 Timezone and DST

    $t->tzoffset            # timezone offset in a Time::Seconds object
    $t->isdst               # also available as $t->daylight_savings

The C<isdst> method returns:

=over 4

=item * 0 for GMT/UTC times (they never have DST)

=item * 0 or 1 for local times depending on whether DST is active

=item * Automatically calculated if unknown

=back

The C<tzoffset> method returns the offset from UTC as a Time::Seconds object.
For GMT/UTC times, this always returns 0. For local times, it calculates
the actual offset including any DST adjustment.

=head2 Utility Methods

    $t->is_leap_year        # true if it's a leap year
    $t->month_last_day      # 28-31

=head2 Global Configuration

    $t->time_separator($s)  # set the default separator (default ":")
    $t->date_separator($s)  # set the default separator (default "-")
    $t->day_list(@days)     # set the default weekdays
    $t->mon_list(@days)     # set the default months

=head2 Parsing

    Time::Piece->strptime(STRING, FORMAT)
                            # see strptime man page. Creates a new
                            # Time::Piece object

B<Note:> C<localtime> and C<gmtime> are not listed above. If called as
methods on a Time::Piece object, they act as constructors, returning a new
Time::Piece object for the current time. In other words: they're not useful as
methods.

=head1 Date Calculations

It's possible to use simple addition and subtraction of objects:

    use Time::Seconds;

    my $seconds = $t1 - $t2;
    $t1 += ONE_DAY; # add 1 day (constant from Time::Seconds)

The following are valid ($t1 and $t2 are Time::Piece objects):

    $t1 - $t2; # returns Time::Seconds object
    $t1 - 42; # returns Time::Piece object
    $t1 + 533; # returns Time::Piece object

B<Note:> All arithmetic uses epoch seconds (UTC). When daylight saving time
(DST) changes occur:

=over 4

=item * Adding seconds works on UTC time, so adding 3600 seconds during DST
transition from 1:30 AM gives 3:30 AM (not 2:30 AM, which doesn't exist
during "spring forward")

=item * Subtracting across DST transitions may differ from wall-clock expectations
due to skipped or repeated hours

=back

=head2 Adding Months and Years

Two methods handle calendar arithmetic differently than seconds-based math:

    $t = $t->add_months(6);
    $t = $t->add_years(5);

B<Important behaviors:>

=over 4

=item * These preserve the day-of-month number, which can cause overflow (Jan 31 + 1
month = Mar 3, since "Feb 31" doesn't exist)

=item * Wall-clock time is preserved across DST transitions

=item * Order matters: C<add_months(1)> then C<+ 86400> gives different results than
C<+ 86400> then C<add_months(1)>

=back

=head1 Truncation

Calling the C<truncate> method returns a copy of the object but with the
time truncated to the start of the supplied unit.

    $t = $t->truncate(to => 'day');

This example will set the time to midnight on the same date which C<$t>
had previously. Allowed values for the "to" parameter are: "year",
"quarter", "month", "day", "hour", "minute" and "second".

=head1 Date Comparisons

Date comparisons are also possible, using the full suite of "<", ">",
"<=", ">=", "<=>", "==" and "!=".

All comparisons use epoch seconds, so they work correctly across timezones:

    my $t1 = localtime;
    my $t2 = gmtime;
    if ($t1 > $t2) {  # Compares actual moments in time, not clock values
        # ...
    }

Time::Piece objects can also be compared as strings using C<cmp>:

    if ($t1 cmp "2024-01-15") {  # Compares against cdate format
        # ...
    }

=head1 Date Parsing

Time::Piece provides flexible date parsing via the built-in C<strptime()>
function (from FreeBSD).

For more information on acceptible formats and flags for C<strptime> see
"man strptime" on unix systems. Alternatively look here:
L<http://www.unix.com/man-page/FreeBSD/3/strftime/>

=head2 Basic Usage

  my $t = Time::Piece->strptime("Sunday 3rd Nov, 1943",
                                "%A %drd %b, %Y");

  print $t->strftime("%a, %d %b %Y");

Outputs:

  Wed, 03 Nov 1943

The default format string is C<"%a, %d %b %Y %H:%M:%S %Z">, so these are equivalent:

    my $t1 = Time::Piece->strptime($string);
    my $t2 = Time::Piece->strptime($string, "%a, %d %b %Y %H:%M:%S %Z");

=head2 Handling Partial Dates

When parsing incomplete date strings, you can provide defaults for missing
components in several ways:

B<Array Reference> - Standard time components (as returned by localtime):

    my @defaults = localtime();
    my $t = Time::Piece->strptime("15 Mar", "%d %b",
                                  { defaults => \@defaults });

B<Hash Reference> - Specify only needed components:

    my $t = Time::Piece->strptime("15 Mar", "%d %b",
                                  { defaults => {
                                      year => 2023,
                                      hour => 14,
                                      min  => 30
                                  } });

Valid keys: C<sec>, C<min>, C<hour>, C<mday>, C<mon>, C<year>, C<wday>, C<yday>, C<isdst>

B<Note>: For the C<year> parameter numbers less than 1000 are treated as an
offset from 1900. Whereas numbers larger than 1000 are treated as the actual year.

B<Time::Piece Object> - Uses all components from the object:

    my $base = localtime();
    my $t = Time::Piece->strptime("15 Mar", "%d %b",
                                  { defaults => $base });

B<Note:> In all cases, parsed values always override defaults. Only missing
components use default values.

=head2 GMT vs Local Time

By default, C<strptime> returns GMT objects when called as a class method:

    # Returns GMT (c_islocal = 0)
    Time::Piece->strptime($string, $format)

To get local time objects, you can:

    # Call as instance method on localtime object
    localtime()->strptime($string, $format)

    # Use explicit islocal option
    Time::Piece->strptime($string, $format, { islocal => 1 })

    # Pass a local Time::Piece object as defaults
    my $local = localtime();
    Time::Piece->strptime($string, $format, { defaults => $local })

=head3 Locale Considerations

By default, C<strptime> only parses English day and month names, while
C<strftime> uses your system locale. This can cause parsing failures for
non-English dates.

To parse localized dates, call C<Time::Piece-E<gt>use_locale()> to build
a list of your locale's day and month names:

    # Enable locale-aware parsing (global setting)
    Time::Piece->use_locale();

    # Now strptime can parse names in your system locale
    my $t = Time::Piece->strptime("15 Marzo 2024", "%d %B %Y");

B<Note:> This is a global change affecting all Time::Piece instances.

You can also override the day/month names manually:

    my @days = qw( Domingo Lunes Martes Miercoles Jueves Viernes Sabado );
    my $spanish_day = localtime->day(@days);

    my @months = qw( Enero Febrero Marzo Abril Mayo Junio
                     Julio Agosto Septiembre Octubre Noviembre Diciembre );
    print localtime->month(@months);

Set globally with:

    Time::Piece::day_list(@days);
    Time::Piece::mon_list(@months);

=head2 Timezone Parsing with %z and %Z

Time::Piece's C<strptime()> function has some limited support for parsing timezone
information through two format specifiers: C<%z> and C<%Z>

Added in version 1.38. Prior to that, these flags were mostly ignored.
Consider the current implementation somewhat "alpha" and in need of feedback.

=head3 Numeric Offsets (%z)

The C<%z> specifier parses numeric timezone offsets (format: C<+HHMM> or C<-HHMM>):

    my $t = Time::Piece->strptime("2024-01-15 15:30:00 +0500",
                                  "%Y-%m-%d %H:%M:%S %z");
    print $t->hour;  # prints 10 (converted to UTC: 15:30 - 5:00)

Key behaviors:

=over 4

=item * Offsets are applied to convert to UTC (C<+0500> means "5 hours ahead of UTC")

=item * Valid range: C<-1200> to C<+1400> with minutes less than 60

=item * For local objects (C<islocal == 1>), the result is converted to system timezone

=back

Times parsed with timezone information default to GMT. To convert to local time:

    # Parse and convert to local timezone
    my $t = Time::Piece->strptime("2024-01-15 15:30:00 +0500",
                                  "%Y-%m-%d %H:%M:%S %z",
                                  { islocal => 1 });
    # Result: 10:30 UTC converted to your local timezone

=head3 Timezone Names (%Z)

The C<%Z> specifier currently only recognizes "GMT" and "UTC" (case-sensitive).
Other timezone names are parsed B<but ignored>:

    # GMT/UTC recognized and handled
    my $t1 = Time::Piece->strptime("2024-01-15 10:30:00 GMT",
                                   "%Y-%m-%d %H:%M:%S %Z");
    print $t1->hour;  # prints 10 (no adjustment)

    # Other timezones parsed but ignored
    my $t2 = Time::Piece->strptime("2024-01-15 10:30:00 PST",
                                   "%Y-%m-%d %H:%M:%S %Z");
    print $t2->hour;  # prints 10 (PST ignored - no adjustment)

B<Note:> Full timezone name support is not currently implemented. For reliable
timezone handling beyond GMT/UTC, consider using the L<DateTime> module.

=head1 Global Overriding

To override localtime and gmtime everywhere:

    use Time::Piece ':override';

This replaces Perl's built-in functions with Time::Piece versions globally.

=head1 CAVEATS

=head2 Setting $ENV{TZ} in Threads on Win32

Note that when using perl in the default build configuration on Win32
(specifically, when perl is built with PERL_IMPLICIT_SYS), each perl
interpreter maintains its own copy of the environment and only the main
interpreter will update the process environment seen by strftime.

Therefore, if you make changes to $ENV{TZ} from inside a thread other than
the main thread then those changes will not be seen by C<strftime> if you
subsequently call that with the %Z formatting code. You must change $ENV{TZ}
in the main thread to have the desired effect in this case (and you must
also call C<_tzset()> in the main thread to register the environment change).

Furthermore, remember that this caveat also applies to fork(), which is
emulated by threads on Win32.

=head2 Use of epoch seconds

This module internally uses the epoch seconds system that is provided via
the perl C<time()> function and supported by C<gmtime()> and C<localtime()>.

If your perl does not support times larger than C<2^31> seconds
(Perl versions < 5.12) then this module is likely to fail at processing dates
beyond the year 2038. If that is not an option, use the L<DateTime> module
which has support for years well into the future and past.

=head1 AUTHOR

Matt Sergeant, matt@sergeant.org
Jarkko Hietaniemi, jhi@iki.fi (while creating Time::Piece for core perl)

=head1 COPYRIGHT AND LICENSE

Copyright 2001, Larry Wall.

This module is free software, you may distribute it under the same terms
as Perl.

=head1 SEE ALSO

The excellent Calendar FAQ at L<http://www.tondering.dk/claus/calendar.html>

=head1 BUGS

=over 4

=item * The test harness leaves much to be desired. Patches welcome.

=item * Proper UTF8 support

=back

=cut