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.41';
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);
}
sub to_gmtime {
&gmtime( $_[0]->epoch );
}
sub to_localtime {
&localtime( $_[0]->epoch );
}
# 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 _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 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 = {
'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 ) = @_;
if ($IS_WIN32) {
my $week = sprintf( "%02d", $time->week() );
$format =~ s/%V/$week/;
}
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 fullday_list {
shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); # strip first if called as a method
my @old = @FULLDAY_LIST;
if (@_) {
@FULLDAY_LIST = @_;
&Time::Piece::_default_locale();
}
return @old;
}
sub fullmon_list {
shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); # strip first if called as a method
my @old = @FULLMON_LIST;
if (@_) {
@FULLMON_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_days {
my ( $time, $num_days ) = @_;
croak("add_days requires a number of days") unless defined($num_days);
return add( $time, $num_days * ONE_DAY );
}
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 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}} {weekday}} = @FULLDAY_LIST;
}
else {
@FULLDAY_LIST = @{$locales->{weekday}};
}
if( @{$locales->{wday}} {wday}} = @DAY_LIST;
}
else {
@DAY_LIST = @{$locales->{wday}};
}
if( @{$locales->{month}} {month}} = @FULLMON_LIST;
}else {
@FULLMON_LIST = @{$locales->{month}};
}
if( @{$locales->{mon}} {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 and C 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
After importing this module, when you use C or C in a scalar
context, rather than getting an ordinary scalar string representing the
date and time, you get a C<:piece> object, whose stringification happens
to produce the same effect as the C and C functions.
The primary way to create Time::Piece objects is through the C and
C functions. There is also a C constructor which is the same as
C, 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"
=head3 strftime Format Flags
The C method calls your system's native C implementation,
so the supported format flags and their behavior will depend on your platform.
B Some format flags behave differently or may be missing
entirely on certain platforms. The following flags are known to have
platform-specific issues: C, C, C, C, C, C, C, C,
C, C, C, C, C, and C.
To mitigate these differences, C<:piece> includes a special translation layer
that attempts to unify behavior across platforms. For example, C is not
available on some Microsoft platforms, so it is automatically converted to
C internally before calling the system's C.
For a complete list of format flags supported by your system, consult your
platform's C manual page (C on Unix-like systems).
=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
$t->to_gmtime # convert to GMT, preserving the epoch
$t->to_localtime # convert to local time, preserving the epoch
The C 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 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.
The C and C methods convert between timezone contexts
while preserving the same moment in time (epoch). They always return a new
Time::Piece object.
=head2 Utility Methods
$t->is_leap_year # true if it's a leap year
$t->month_last_day # 28-31
$t->add_days # Add days
$t->add_months # Add months
$t->add_years # Add years
=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 names used by wdayname()
$t->mon_list(@months) # set the names used by month()
$t->fullday_list(@days) # set the names used by fullday()
$t->fullmon_list(@months) # set the names used by fullmonth()
=head2 Parsing
Time::Piece->strptime(STRING, FORMAT)
# see strptime man page. Creates a new
# Time::Piece object
B C and C 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
$t1->add_days(2); # returns Time::Piece object
B 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
=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 then C gives different results than
C then C
=back
=head1 Truncation
Calling the C 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
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:
if ($t1 cmp "2024-01-15") { # Compares against cdate format
# ...
}
=head1 Date Parsing
Time::Piece provides flexible date parsing via the built-in C
function (from FreeBSD).
For more information on acceptible formats and flags for C see
"man strptime" on unix systems. Alternatively look here:
L
=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, 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 Supported Format Flags
C<:piece> uses a custom C implementation that supports the
following format flags:
Flag Description
---- -----------
%% Literal '%' character
%a Abbreviated weekday name (Mon, Tue, etc.)
%A Full weekday name (Monday, Tuesday, etc.)
%b Abbreviated month name (Jan, Feb, etc.)
%B Full month name (January, February, etc.)
%C Century number (00-99)
%d Day of month (01-31)
%D Equivalent to %m/%d/%y
%e Day of month ( 1-31, space-padded)
%f Fractional seconds as microseconds (up to 6 digits, parsed but ignored)
%F Equivalent to %Y-%m-%d (ISO 8601 date format)
%h Abbreviated month name (same as %b)
%H Hour in 24-hour format (00-23)
%I Hour in 12-hour format (01-12)
%j Day of year (001-366)
%k Hour in 24-hour format ( 0-23, space-padded)
%l Hour in 12-hour format ( 1-12, space-padded)
%m Month number (01-12)
%M Minute (00-59)
%n Any whitespace
%p AM/PM indicator
%P Alt AM/PM indicator
%r Time in AM/PM format (%I:%M:%S %p, or %H:%M:%S if locale has no AM/PM)
%R Equivalent to %H:%M
%s Seconds since Unix epoch (1970-01-01 00:00:00 UTC)
%S Second (00-60, allowing for leap seconds)
%t Any whitespace (same as %n)
%T Equivalent to %H:%M:%S
%u Weekday as number (1-7, Monday = 1)
%w Weekday as number (0-6, Sunday = 0)
%y Year within century (00-99). Values 00-68 are 2000-2068, 69-99 are 1969-1999
%Y Year with century (e.g., 2024)
%z Timezone offset (+HHMM, -HHMM, +HH:MM, or -HH:MM)
%Z Timezone name (only GMT and UTC recognized; others parsed but ignored)
B The format flags C, C, and C are B
supported as they are highly locale-dependent and have inconsistent formats
across systems. However, you can construct equivalent formats using the individual
flags listed above. For example, C is typically equivalent to something like:
"%a %b %e %H:%M:%S %Y" # e.g., "Tue Feb 29 12:34:56 2000"
B C, C, and C (week number formats) are parsed but not fully
implemented in the strptime logic, as they require additional date components
to calculate the actual date.
B C (fractional seconds) is only supported in C for parsing.
It is not available in C for output formatting, as Time::Piece uses
epoch seconds which do not store subsecond precision.
=head2 GMT vs Local Time
By default, C 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 })
The islocal and defaults options were added in version 1.37; the instance
method can be used for compatibility with previous versions.
=head2 Timezone Parsing with %z and %Z
Time::Piece's C function has some limited support for parsing timezone
information through two format specifiers: C and C
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 specifier parses numeric timezone offsets
(format: C, C, or C):
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 means "5 hours ahead of UTC")
=item * Valid range: C to C with minutes less than 60
=item * For local objects (C), 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 specifier currently only recognizes "GMT" and "UTC" (case-sensitive).
Other timezone names are parsed B:
# 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)
# Parse and convert to local timezone
my $t3 = Time::Piece->strptime("2024-01-15 15:30:00 UTC",
"%Y-%m-%d %H:%M:%S %Z",
{ islocal => 1 });
print $t3->hour; # prints 10:30 UTC converted to your local timezone
B Full timezone name support is not currently implemented. For reliable
timezone handling beyond GMT/UTC, consider using the L module.
=head2 Handling Partial Dates
When parsing incomplete date strings, you can provide defaults for missing
components in several ways:
B - Standard time components (as returned by localtime):
my @defaults = localtime();
my $t = Time::Piece->strptime("15 Mar", "%d %b",
{ defaults => \@defaults });
B - Specify only needed components:
my $t = Time::Piece->strptime("15 Mar", "%d %b",
{ defaults => {
year => 2023,
hour => 14,
min => 30
} });
Valid keys: C, C, C, C, C, C, C, C, C
B: For the C parameter numbers less than 1000 are treated as an
offset from 1900. Whereas numbers larger than 1000 are treated as the actual year.
B<:piece object> - Uses all components from the object:
my $base = localtime();
my $t = Time::Piece->strptime("15 Mar", "%d %b",
{ defaults => $base });
B In all cases, parsed values always override defaults. Only missing
components use default values.
=head2 Locale Considerations
By default, C only parses English day and month names, while
C uses your system locale. This can cause parsing failures for
non-English dates.
To parse localized dates, call C<:piece-e>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 This is a global change affecting all Time::Piece instances.
You can also override the day/month names manually:
# Abbreviated day names
my @days = qw( Dom Lun Mar Mie Jue Vie Sab );
my $spanish_day = localtime->day(@days);
# Full day names
my @fulldays = qw( Domingo Lunes Martes Miercoles Jueves Viernes Sabado );
my $spanish_fullday = localtime->fullday(@fulldays);
# Abbreviated month names
my @months = qw( Ene Feb Mar Abr May Jun Jul Ago Sep Oct Nov Dic );
print localtime->month(@months);
# Full month names
my @fullmonths = qw( Enero Febrero Marzo Abril Mayo Junio
Julio Agosto Septiembre Octubre Noviembre Diciembre );
print localtime->fullmonth(@fullmonths);
Set globally with:
Time::Piece::day_list(@days);
Time::Piece::mon_list(@months);
Time::Piece::fullday_list(@fulldays);
Time::Piece::fullmon_list(@fullmonths);
=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 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