@@ -19,7 +19,7 @@ our %EXPORT_TAGS = (
19
19
' :override' => ' internal' ,
20
20
);
21
21
22
- our $VERSION = ' 1.35 ' ;
22
+ our $VERSION = ' 1.36 ' ;
23
23
24
24
XSLoader::load( ' Time::Piece' , $VERSION );
25
25
@@ -124,12 +124,7 @@ sub _mktime {
124
124
$class = blessed($class ) || $class ;
125
125
126
126
if ($class -> _is_time_struct($time )) {
127
- my @new_time = @$time ;
128
- my @tm_parts = (@new_time [c_sec .. c_mon], $new_time [c_year]+1900);
129
-
130
- $new_time [c_epoch] = $islocal ? timelocal(@tm_parts ) : timegm(@tm_parts );
131
-
132
- return wantarray ? @new_time : bless [@new_time [0..9], $islocal ], $class ;
127
+ return wantarray ? @$time : bless [@$time [0..8], undef , $islocal ], $class ;
133
128
}
134
129
_tzset();
135
130
my @time = $islocal ?
@@ -477,8 +472,7 @@ sub month_last_day {
477
472
return $MON_LAST [$_mon] + ($_mon == 1 ? _is_leap_year($year ) : 0);
478
473
}
479
474
480
- my $trans_map_common = {
481
-
475
+ my $strftime_trans_map = {
482
476
' c' => sub {
483
477
my ( $format ) = @_ ;
484
478
if ($LOCALE -> {PM } && $LOCALE -> {AM }){
@@ -489,65 +483,51 @@ my $trans_map_common = {
489
483
}
490
484
return $format ;
491
485
},
492
- ' r' => sub {
493
- my ( $format ) = @_ ;
494
- if ($LOCALE -> {PM } && $LOCALE -> {AM }){
495
- $format =~ s / %r/ %I :%M :%S %p / ;
496
- }
497
- else {
498
- $format =~ s / %r/ %H :%M :%S / ;
499
- }
500
- return $format ;
501
- },
502
- ' X' => sub {
503
- my ( $format ) = @_ ;
504
- if ($LOCALE -> {PM } && $LOCALE -> {AM }){
505
- $format =~ s / %X/ %I :%M :%S %p / ;
506
- }
507
- else {
508
- $format =~ s / %X/ %H :%M :%S / ;
509
- }
510
- return $format ;
511
- },
512
- };
513
-
514
- my $strftime_trans_map = {
515
- %{$trans_map_common },
516
-
517
486
' e' => sub {
518
- my ( $format , $time ) = @_ ;
487
+ my ( $format ) = @_ ;
519
488
$format =~ s / %e/ %d / if $IS_WIN32 ;
520
489
return $format ;
521
490
},
522
491
' D' => sub {
523
- my ( $format , $time ) = @_ ;
492
+ my ( $format ) = @_ ;
524
493
$format =~ s / %D/ %m \/ %d \/ %y / ;
525
494
return $format ;
526
495
},
527
496
' F' => sub {
528
- my ( $format , $time ) = @_ ;
497
+ my ( $format ) = @_ ;
529
498
$format =~ s / %F/ %Y -%m -%d / ;
530
499
return $format ;
531
500
},
501
+ ' r' => sub {
502
+ my ( $format ) = @_ ;
503
+ if ($LOCALE -> {PM } && $LOCALE -> {AM }){
504
+ $format =~ s / %r/ %I :%M :%S %p / ;
505
+ }
506
+ else {
507
+ $format =~ s / %r/ %H :%M :%S / ;
508
+ }
509
+ return $format ;
510
+ },
532
511
' R' => sub {
533
- my ( $format , $time ) = @_ ;
512
+ my ( $format ) = @_ ;
534
513
$format =~ s / %R/ %H :%M / ;
535
514
return $format ;
536
515
},
537
516
' s' => sub {
538
517
# %s not portable if time parts are from gmtime since %s will
539
518
# cause a call to native mktime (and thus uses local TZ)
540
519
my ( $format , $time ) = @_ ;
541
- $format =~ s / %s/ $time ->[c_epoch]/ ;
520
+ my $e = $time -> epoch();
521
+ $format =~ s / %s/ $e / ;
542
522
return $format ;
543
523
},
544
524
' T' => sub {
545
- my ( $format , $time ) = @_ ;
525
+ my ( $format ) = @_ ;
546
526
$format =~ s / %T/ %H :%M :%S / if $IS_WIN32 ;
547
527
return $format ;
548
528
},
549
529
' u' => sub {
550
- my ( $format , $time ) = @_ ;
530
+ my ( $format ) = @_ ;
551
531
$format =~ s / %u/ %w / if $IS_WIN32 ;
552
532
return $format ;
553
533
},
@@ -558,10 +538,20 @@ my $strftime_trans_map = {
558
538
return $format ;
559
539
},
560
540
' x' => sub {
561
- my ( $format , $time ) = @_ ;
541
+ my ( $format ) = @_ ;
562
542
$format =~ s / %x/ %a %d %b %Y / ;
563
543
return $format ;
564
544
},
545
+ ' X' => sub {
546
+ my ( $format ) = @_ ;
547
+ if ($LOCALE -> {PM } && $LOCALE -> {AM }){
548
+ $format =~ s / %X/ %I :%M :%S %p / ;
549
+ }
550
+ else {
551
+ $format =~ s / %X/ %H :%M :%S / ;
552
+ }
553
+ return $format ;
554
+ },
565
555
' z' => sub { # %[zZ] not portable if time parts are from gmtime
566
556
my ( $format , $time ) = @_ ;
567
557
$format =~ s / %z/ +0000/ if not $time -> [c_islocal];
@@ -584,17 +574,13 @@ sub strftime {
584
574
return _strftime($format , $time -> epoch, $time -> [c_islocal]);
585
575
}
586
576
587
- my $strptime_trans_map = {
588
- %{$trans_map_common },
589
- };
590
-
591
577
sub strptime {
592
578
my $time = shift ;
593
579
my $string = shift ;
594
580
my $format = @_ ? shift (@_ ) : " %a , %d %b %Y %H :%M :%S %Z " ;
595
581
my $islocal = (ref ($time ) ? $time -> [c_islocal] : 0);
596
582
my $locales = $LOCALE || &Time::Piece::_default_locale();
597
- $format = _translate_format( $format , $strptime_trans_map );
583
+
598
584
my @vals = _strptime($string , $format , $islocal , $locales );
599
585
# warn(sprintf("got vals: %d-%d-%d %d:%d:%d\n", reverse(@vals[c_sec..c_year])));
600
586
return scalar $time -> _mktime(\@vals , $islocal );
@@ -680,6 +666,9 @@ sub subtract {
680
666
return $rhs - " $time " ;
681
667
}
682
668
669
+ # TODO: handle math with objects where one is DST and the other isn't
670
+ # 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)
671
+ # or check the tzoffset on each object, if they are different, add in the differing seconds.
683
672
if (blessed($rhs ) && $rhs -> isa(' Time::Piece' )) {
684
673
return Time::Seconds-> new($time -> epoch - $rhs -> epoch);
685
674
}
@@ -771,10 +760,17 @@ sub truncate {
771
760
$time -> [c_islocal]);
772
761
}
773
762
763
+ my $_format_cache = {};
764
+
774
765
# Given a format and a translate map, replace format flags in
775
766
# accordance with the logic from the translation map subroutines
776
767
sub _translate_format {
777
768
my ( $format , $trans_map , $time ) = @_ ;
769
+ my $can_cache = ($format !~ / %([sVzZ])/ ) ? 1 : 0;
770
+
771
+ if ( $can_cache && exists $_format_cache-> {$format } ){
772
+ return $_format_cache-> {$format };
773
+ }
778
774
779
775
$format =~ s / %%/ \e\e / g ; # escape the escape
780
776
my $lexer = _build_format_lexer($format );
@@ -785,6 +781,8 @@ sub _translate_format {
785
781
}
786
782
787
783
$format =~ s /\e\e / %%/ g ;
784
+ $_format_cache-> {$_ [0]} = $format if $can_cache ;
785
+
788
786
return $format ;
789
787
}
790
788
0 commit comments