@@ -19,18 +19,20 @@ our %EXPORT_TAGS = (
1919 ' :override' => ' internal' ,
2020 );
2121
22- our $VERSION = ' 1.36 ' ;
22+ our $VERSION = ' 1.3701 ' ;
2323
2424XSLoader::load( ' Time::Piece' , $VERSION );
2525
2626my $DATE_SEP = ' -' ;
2727my $TIME_SEP = ' :' ;
28+ my $DATE_FORMAT = ' %a, %d %b %Y %H:%M:%S %Z' ;
2829my @MON_LIST = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec) ;
2930my @FULLMON_LIST = qw( January February March April May June July
3031 August September October November December) ;
3132my @DAY_LIST = qw( Sun Mon Tue Wed Thu Fri Sat) ;
3233my @FULLDAY_LIST = qw( Sunday Monday Tuesday Wednesday Thursday Friday Saturday) ;
3334my $IS_WIN32 = ($^O =~ / Win32/ );
35+ my $IS_LINUX = ($^O =~ / linux/i );
3436
3537my $LOCALE ;
3638
@@ -296,7 +298,12 @@ sub yday {
296298
297299sub 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
567595sub 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
577605sub 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
589676sub day_list {
@@ -766,7 +853,8 @@ my $_format_cache = {};
766853# accordance with the logic from the translation map subroutines
767854sub _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
9831077to index the name of the days against. This can be useful if you need
9841078to implement some form of localisation without actually installing or
9851079using 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
10701165Outputs:
@@ -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
10791238Alternatively 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
11261269Finally, it's possible to override localtime and gmtime everywhere, by
0 commit comments