Skip to content

Commit 8d0a0f0

Browse files
smith153jkeenan
authored andcommitted
cpan/Time-Piece - Update to version 1.3701
1.3701 2025-08-25 - Test fixes on Alpine and locales without AM/PM (GH76) 1.37 2025-08-16 - Allow custom default values from strptime (GH48,49) - Allow islocal return from Time::Piece->strptime (GH44) - Windows support for %k, %l, %P - Set c_isdst after strptime (GH9)
1 parent 62a961f commit 8d0a0f0

File tree

10 files changed

+841
-146
lines changed

10 files changed

+841
-146
lines changed

MANIFEST

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3180,6 +3180,7 @@ cpan/Time-Piece/t/07arith.t Test for Time::Piece
31803180
cpan/Time-Piece/t/08truncate.t Test file related to Time::Piece
31813181
cpan/Time-Piece/t/09locales.t Test file related to Time::Piece
31823182
cpan/Time-Piece/t/10overload.t Test file related to Time::Piece
3183+
cpan/Time-Piece/t/11strptime_defaults.t Time-Piece
31833184
cpan/Time-Piece/t/99legacy.t Test file related to Time::Piece
31843185
cpan/Time-Piece/t/lib/Time/Piece/Twin.pm Module related to Time::Piece
31853186
cpan/Unicode-Collate/Collate.pm Unicode::Collate

Porting/Maintainers.pl

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1254,8 +1254,8 @@ package Maintainers;
12541254
},
12551255

12561256
'Time::Piece' => {
1257-
'DISTRIBUTION' => 'ESAYM/Time-Piece-1.36.tar.gz',
1258-
'SYNCINFO' => 'jkeenan on Fri Apr 11 07:13:44 2025',
1257+
'DISTRIBUTION' => 'ESAYM/Time-Piece-1.3701.tar.gz',
1258+
'SYNCINFO' => 'jkeenan on Sun Aug 31 22:21:48 2025',
12591259
'FILES' => q[cpan/Time-Piece],
12601260
'EXCLUDED' => [ qw[reverse_deps.txt] ],
12611261
},

cpan/Time-Piece/Piece.pm

Lines changed: 180 additions & 37 deletions
Original file line numberDiff line numberDiff line change
@@ -19,18 +19,20 @@ our %EXPORT_TAGS = (
1919
':override' => 'internal',
2020
);
2121

22-
our $VERSION = '1.36';
22+
our $VERSION = '1.3701';
2323

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

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

3537
my $LOCALE;
3638

@@ -296,7 +298,12 @@ sub yday {
296298

297299
sub isdst {
298300
my $time = shift;
299-
$time->[c_isdst];
301+
return 0 unless $time->[c_islocal];
302+
# Calculate dst based on current TZ
303+
if ( $time->[c_isdst] == -1 ) {
304+
$time->[c_isdst] = ( CORE::localtime( $time->epoch ) )[-1];
305+
}
306+
return $time->[c_isdst];
300307
}
301308

302309
*daylight_savings = \&isdst;
@@ -484,8 +491,9 @@ my $strftime_trans_map = {
484491
return $format;
485492
},
486493
'e' => sub {
487-
my ( $format ) = @_;
488-
$format =~ s/%e/%d/ if $IS_WIN32;
494+
my ( $format, $time ) = @_;
495+
my $day = sprintf( "%2d", $time->[c_mday] );
496+
$format =~ s/%e/$day/ if $IS_WIN32;
489497
return $format;
490498
},
491499
'D' => sub {
@@ -498,6 +506,26 @@ my $strftime_trans_map = {
498506
$format =~ s/%F/%Y-%m-%d/;
499507
return $format;
500508
},
509+
'k' => sub {
510+
my ( $format, $time ) = @_;
511+
my $hr = sprintf( "%2d", $time->[c_hour] );
512+
$format =~ s/%k/$hr/;
513+
return $format;
514+
},
515+
'l' => sub {
516+
my ( $format, $time ) = @_;
517+
my $hr = $time->[c_hour] > 12 ? $time->[c_hour] - 12 : $time->[c_hour];
518+
$hr = 12 unless $hr;
519+
$hr = sprintf( "%2d", $hr );
520+
$format =~ s/%l/$hr/;
521+
return $format;
522+
},
523+
'P' => sub {
524+
my ( $format ) = @_;
525+
# %P seems to be linux only
526+
$format =~ s/%P/%p/ unless $IS_LINUX;
527+
return $format;
528+
},
501529
'r' => sub {
502530
my ( $format ) = @_;
503531
if($LOCALE->{PM} && $LOCALE->{AM}){
@@ -566,7 +594,7 @@ my $strftime_trans_map = {
566594

567595
sub strftime {
568596
my $time = shift;
569-
my $format = @_ ? shift(@_) : '%a, %d %b %Y %H:%M:%S %Z';
597+
my $format = @_ ? shift(@_) : $DATE_FORMAT;
570598
$format = _translate_format($format, $strftime_trans_map, $time);
571599

572600
return $format unless $format =~ /%/; #if translate removes everything
@@ -575,15 +603,74 @@ sub strftime {
575603
}
576604

577605
sub strptime {
578-
my $time = shift;
606+
my $time = shift;
579607
my $string = shift;
580-
my $format = @_ ? shift(@_) : "%a, %d %b %Y %H:%M:%S %Z";
581-
my $islocal = (ref($time) ? $time->[c_islocal] : 0);
582-
my $locales = $LOCALE || &Time::Piece::_default_locale();
608+
my $format;
609+
my $opts;
610+
611+
if ( @_ >= 2 && blessed( $_[1] ) && $_[1]->isa('Time::Piece') ) {
612+
# $string, $format, $time_piece_object
613+
$format = shift;
614+
$opts = { defaults => shift };
615+
} elsif ( @_ && blessed( $_[0] ) && $_[0]->isa('Time::Piece') ) {
616+
# $string, $time_piece_object
617+
$opts = { defaults => shift };
618+
$format = $DATE_FORMAT;
619+
} elsif ( @_ >= 2 && ref( $_[1] ) eq 'HASH' ) {
620+
# $string, $format, {options => ...}
621+
$format = shift;
622+
$opts = shift;
623+
} elsif ( @_ && ref( $_[0] ) eq 'HASH' ) {
624+
# $string, {options => ...}
625+
$opts = shift;
626+
$format = @_ ? shift : $DATE_FORMAT;
627+
} else {
628+
$format = @_ ? shift : $DATE_FORMAT;
629+
}
630+
631+
my $islocal = ( ref($time) ? $time->[c_islocal] : 0 );
632+
my $locales = $LOCALE || &Time::Piece::_default_locale();
633+
my $defaults = [];
634+
635+
if ($opts) {
636+
# Validate and process defaults if provided
637+
if ( exists $opts->{defaults} ) {
638+
if ( ref( $opts->{defaults} ) eq 'ARRAY' ) {
639+
$defaults = $opts->{defaults};
640+
unless ( @{ $opts->{defaults} } >= 8 ) {
641+
croak("defaults array must have at least 8 elements!");
642+
}
643+
} elsif ( ref( $opts->{defaults} ) eq 'HASH' ) {
644+
645+
( exists $opts->{defaults}{$_} )
646+
? push( @{$defaults}, $opts->{defaults}{$_} )
647+
: push( @{$defaults}, undef )
648+
for qw/sec min hour mday mon year wday yday/;
649+
650+
if ( defined $defaults->[c_year]
651+
&& $defaults->[c_year] >= 1000 ) {
652+
$defaults->[c_year] -= 1900;
653+
}
654+
655+
} elsif ( blessed( $opts->{defaults} )
656+
&& $opts->{defaults}->isa('Time::Piece') ) {
657+
# Extract time components from Time::Piece object
658+
$defaults = [ @{ $opts->{defaults} }[ c_sec .. c_yday ] ];
659+
$islocal = $opts->{defaults}[c_islocal];
660+
} else {
661+
croak("defaults must be an array reference, hash reference, or Time::Piece object");
662+
}
663+
}
664+
665+
# Check for forced islocal
666+
if ( exists $opts->{islocal} && $opts->{islocal} ) {
667+
$islocal = 1;
668+
}
669+
}
670+
671+
my @vals = _strptime( $string, $format, $islocal, $locales, $defaults );
583672

584-
my @vals = _strptime($string, $format, $islocal, $locales);
585-
# warn(sprintf("got vals: %d-%d-%d %d:%d:%d\n", reverse(@vals[c_sec..c_year])));
586-
return scalar $time->_mktime(\@vals, $islocal);
673+
return scalar $time->_mktime( \@vals, $islocal );
587674
}
588675

589676
sub day_list {
@@ -766,7 +853,8 @@ my $_format_cache = {};
766853
#accordance with the logic from the translation map subroutines
767854
sub _translate_format {
768855
my ( $format, $trans_map, $time ) = @_;
769-
my $can_cache = ($format !~ /%([sVzZ])/) ? 1 : 0;
856+
my $bad_flags = $IS_WIN32 ? qr/%([eklsVzZ])/ : qr/%([klszZ])/;
857+
my $can_cache = ($format !~ $bad_flags) ? 1 : 0;
770858

771859
if ( $can_cache && exists $_format_cache->{$format} ){
772860
return $_format_cache->{$format};
@@ -813,8 +901,14 @@ sub use_locale {
813901
$locales->{AM} = '';
814902
}
815903

816-
$locales->{pm} = lc $locales->{PM};
817-
$locales->{am} = lc $locales->{AM};
904+
if ( !$locales->{pm}
905+
|| !$locales->{am}
906+
|| ( $locales->{pm} eq $locales->{am} ) )
907+
{
908+
$locales->{pm} = lc $locales->{PM};
909+
$locales->{am} = lc $locales->{AM};
910+
}
911+
818912
#should probably figure out how to get a
819913
#region specific format for %c someday
820914
$locales->{c_fmt} = '';
@@ -979,7 +1073,7 @@ methods.
9791073
9801074
=head2 Local Locales
9811075
982-
Both wdayname (day) and monname (month) allow passing in a list to use
1076+
Both C<wdayname> (day) and C<monname> (month) allow passing in a list to use
9831077
to index the name of the days against. This can be useful if you need
9841078
to implement some form of localisation without actually installing or
9851079
using locales. Note that this is a global override and will affect
@@ -1059,12 +1153,13 @@ Date comparisons are also possible, using the full suite of "<", ">",
10591153
10601154
=head2 Date Parsing
10611155
1062-
Time::Piece has a built-in strptime() function (from FreeBSD), allowing
1063-
you incredibly flexible date parsing routines. For example:
1156+
Time::Piece provides flexible date parsing via the built-in strptime() function (from FreeBSD).
1157+
1158+
=head3 Basic Usage
10641159
10651160
my $t = Time::Piece->strptime("Sunday 3rd Nov, 1943",
10661161
"%A %drd %b, %Y");
1067-
1162+
10681163
print $t->strftime("%a, %d %b %Y");
10691164
10701165
Outputs:
@@ -1073,8 +1168,72 @@ Outputs:
10731168
10741169
(see, it's even smart enough to fix my obvious date bug)
10751170
1076-
For more information see "man strptime", which should be on all unix
1077-
systems.
1171+
=head3 Default Values for Partial Dates
1172+
1173+
When parsing incomplete date strings, you can provide defaults for missing components:
1174+
1175+
=head4 Supported Default Types
1176+
1177+
B<1. Array Reference> - Standard time components (sec, min, hour, mday, mon, year, wday, yday) (see C<perldoc -f localtime>):
1178+
1179+
my @defaults = localtime();
1180+
my $t = Time::Piece->strptime("15 Mar", "%d %b",
1181+
{ defaults => \@defaults });
1182+
1183+
B<2. Hash Reference> - Specify only needed components:
1184+
1185+
my $t = Time::Piece->strptime("15 Mar", "%d %b",
1186+
{ defaults => {
1187+
year => 2023, # Years >= 1000: actual year
1188+
hour => 14, # Years < 1000: offset from 1900
1189+
min => 30
1190+
} });
1191+
1192+
Valid keys: C<sec>, C<min>, C<hour>, C<mday>, C<mon>, C<year>, C<wday>, C<yday>, C<isdst>
1193+
1194+
B<Note:> C<year> in this context doesn't have to be an offset from 1900
1195+
1196+
B<3. Time::Piece Object> - Copies all components including C<c_islocal>:
1197+
1198+
my $base = localtime();
1199+
1200+
my $t1 = Time::Piece->strptime("15 Mar", "%d %b",
1201+
{ defaults => $base });
1202+
1203+
# Shorthand (equivalent)
1204+
my $t2 = Time::Piece->strptime("15 Mar", "%d %b", $base);
1205+
1206+
=head4 Format String Defaults
1207+
1208+
When omitted, format defaults to C<"%a, %d %b %Y %H:%M:%S %Z">:
1209+
1210+
# These are equivalent:
1211+
my $t1 = Time::Piece->strptime($string);
1212+
my $t2 = Time::Piece->strptime($string, "%a, %d %b %Y %H:%M:%S %Z");
1213+
1214+
=head3 Timezone Behavior
1215+
1216+
The returned object's timezone (C<c_islocal>) depends on the calling context:
1217+
1218+
B<Default: GMT/UTC> (c_islocal = 0)
1219+
1220+
Time::Piece->strptime($string, $format) # Class method returns GMT
1221+
1222+
B<Local Time> (c_islocal = 1) via:
1223+
1224+
# Instance method on localtime object
1225+
localtime()->strptime($string, $format)
1226+
1227+
# Explicit islocal option
1228+
Time::Piece->strptime($string, $format, { islocal => 1 })
1229+
1230+
# Inherited from Time::Piece defaults
1231+
my $tp_obj = localtime();
1232+
Time::Piece->strptime($string, $format, $tp_obj)
1233+
1234+
B<Note:> Parsed values always override defaults. Only missing components use default values.
1235+
1236+
For more information see "man strptime" on unix systems.
10781237
10791238
Alternatively look here: L<http://www.unix.com/man-page/FreeBSD/3/strftime/>
10801239
@@ -1105,22 +1264,6 @@ Returns
11051264
11061265
( 'So', 'Mo', 'Di', 'Mi', 'Do', 'Fr', 'Sa' )
11071266
1108-
=head2 YYYY-MM-DDThh:mm:ss
1109-
1110-
The ISO 8601 standard defines the date format to be YYYY-MM-DD, and
1111-
the time format to be hh:mm:ss (24 hour clock), and if combined, they
1112-
should be concatenated with date first and with a capital 'T' in front
1113-
of the time.
1114-
1115-
=head2 Week Number
1116-
1117-
The I<week number> may be an unknown concept to some readers. The ISO
1118-
8601 standard defines that weeks begin on a Monday and week 1 of the
1119-
year is the week that includes both January 4th and the first Thursday
1120-
of the year. In other words, if the first Monday of January is the
1121-
2nd, 3rd, or 4th, the preceding days of the January are part of the
1122-
last week of the preceding year. Week numbers range from 1 to 53.
1123-
11241267
=head2 Global Overriding
11251268
11261269
Finally, it's possible to override localtime and gmtime everywhere, by

0 commit comments

Comments
 (0)