In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/23c687d9d091a545afb2b769447c17fba98ba87a?hp=0599cd66b4e9bae6409714e39aa0eebc67712ca7>
- Log ----------------------------------------------------------------- commit 23c687d9d091a545afb2b769447c17fba98ba87a Author: David Mitchell <[email protected]> Date: Sat Jun 24 09:27:50 2017 +0100 upgrade Time-Piece from 1.31 to 1.3201 1.3201 2017-06-22 - Fix compile errors on MS - Use macro for buf sizes - Remove some compile warnings - SP of by 1 in _crt_localtime 1.32 2017-06-20 - Since 1.31: - New truncate() method - Add new flags: %F, %T, %P + more - Add rudimentary locale support via use_locale() - More tests - Less bugs (hopefully) 1.31_04 2017-06-16 - Tests for %F and %T - Fix wrong test count on Windows - Use sensible defaults for strptime 1.31_03 2017-06-14 - Don't use localization on default - Bugs with %s in strptime fixed 1.31_02 2017-01-16 - Add better localization between strftime and strptime 1.31_01 2017-01-13 - Respect singular for 1 sec, min, etc. in pretty (choroba) - Add truncate() (openstrike) - Add many more tests (openstrike) - Add more compatibility to strf/strptime M Porting/Maintainers.pl M cpan/Time-Piece/Piece.pm M cpan/Time-Piece/Piece.xs M cpan/Time-Piece/Seconds.pm M cpan/Time-Piece/t/02core.t M cpan/Time-Piece/t/02core_dst.t M cpan/Time-Piece/t/03compare.t M cpan/Time-Piece/t/07arith.t commit 060e131ef7ef9bfe80a0751328042b9d1ae24139 Author: David Mitchell <[email protected]> Date: Sat Jun 24 09:16:02 2017 +0100 upgrade Scalar-List-Utils from 1.47 to 1.48 [CHANGES] * Note in documentation that outer function's @_ can be accessed in some blocks, but ought not be (thanks wchristian) [BUGFIXES] * Ensure pairmap extends its stack correctly (thanks davem) * Fix name of List::Util::unpairs in its error messages M Porting/Maintainers.pl M cpan/Scalar-List-Utils/ListUtil.xs M cpan/Scalar-List-Utils/lib/List/Util.pm M cpan/Scalar-List-Utils/lib/List/Util/XS.pm M cpan/Scalar-List-Utils/lib/Scalar/Util.pm M cpan/Scalar-List-Utils/lib/Sub/Util.pm M cpan/Scalar-List-Utils/t/pair.t ----------------------------------------------------------------------- Summary of changes: Porting/Maintainers.pl | 4 +- cpan/Scalar-List-Utils/ListUtil.xs | 66 ++++-- cpan/Scalar-List-Utils/lib/List/Util.pm | 11 +- cpan/Scalar-List-Utils/lib/List/Util/XS.pm | 2 +- cpan/Scalar-List-Utils/lib/Scalar/Util.pm | 2 +- cpan/Scalar-List-Utils/lib/Sub/Util.pm | 2 +- cpan/Scalar-List-Utils/t/pair.t | 12 +- cpan/Time-Piece/Piece.pm | 312 +++++++++++++++++++++++++++-- cpan/Time-Piece/Piece.xs | 301 ++++++++++++++-------------- cpan/Time-Piece/Seconds.pm | 23 ++- cpan/Time-Piece/t/02core.t | 60 ++---- cpan/Time-Piece/t/02core_dst.t | 15 +- cpan/Time-Piece/t/03compare.t | 10 +- cpan/Time-Piece/t/07arith.t | 40 +++- 14 files changed, 602 insertions(+), 258 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 1fe22ba8fd..847f62574e 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -959,7 +959,7 @@ use File::Glob qw(:case); }, 'Scalar-List-Utils' => { - 'DISTRIBUTION' => 'PEVANS/Scalar-List-Utils-1.47.tar.gz', + 'DISTRIBUTION' => 'PEVANS/Scalar-List-Utils-1.48.tar.gz', 'FILES' => q[cpan/Scalar-List-Utils], }, @@ -1197,7 +1197,7 @@ use File::Glob qw(:case); }, 'Time::Piece' => { - 'DISTRIBUTION' => 'ESAYM/Time-Piece-1.31.tar.gz', + 'DISTRIBUTION' => 'ESAYM/Time-Piece-1.3201.tar.gz', 'FILES' => q[cpan/Time-Piece], }, diff --git a/cpan/Scalar-List-Utils/ListUtil.xs b/cpan/Scalar-List-Utils/ListUtil.xs index 9db38045f9..2369919f85 100644 --- a/cpan/Scalar-List-Utils/ListUtil.xs +++ b/cpan/Scalar-List-Utils/ListUtil.xs @@ -636,9 +636,9 @@ PPCODE: SvGETMAGIC(pair); if(SvTYPE(pair) != SVt_RV) - croak("Not a reference at List::Util::unpack() argument %d", i); + croak("Not a reference at List::Util::unpairs() argument %d", i); if(SvTYPE(SvRV(pair)) != SVt_PVAV) - croak("Not an ARRAY reference at List::Util::unpack() argument %d", i); + croak("Not an ARRAY reference at List::Util::unpairs() argument %d", i); /* TODO: assert pair is an ARRAY ref */ pairav = (AV *)SvRV(pair); @@ -905,6 +905,7 @@ PPCODE: SV **stack = PL_stack_base + ax; I32 ret_gimme = GIMME_V; int i; + AV *spill = NULL; /* accumulates results if too big for stack */ dMULTICALL; I32 gimme = G_ARRAY; @@ -914,41 +915,64 @@ PPCODE: for(; argi < items; argi += 2) { int count; - GvSV(agv) = args_copy ? args_copy[argi] : stack[argi]; - GvSV(bgv) = argi < items-1 ? - (args_copy ? args_copy[argi+1] : stack[argi+1]) : - &PL_sv_undef; + GvSV(agv) = stack[argi]; + GvSV(bgv) = argi < items-1 ? stack[argi+1]: &PL_sv_undef; MULTICALL; count = PL_stack_sp - PL_stack_base; - if(count > 2 && !args_copy) { + if (count > 2 || spill) { /* We can't return more than 2 results for a given input pair - * without trashing the remaining argmuents on the stack still - * to be processed. So, we'll copy them out to a temporary - * buffer and work from there instead. + * without trashing the remaining arguments on the stack still + * to be processed, or possibly overrunning the stack end. + * So, we'll accumulate the results in a temporary buffer + * instead. * We didn't do this initially because in the common case, most * code blocks will return only 1 or 2 items so it won't be * necessary */ - int n_args = items - argi; - Newx(args_copy, n_args, SV *); - SAVEFREEPV(args_copy); - - Copy(stack + argi, args_copy, n_args, SV *); + int fill; + + if (!spill) { + spill = newAV(); + AvREAL_off(spill); /* don't ref count its contents */ + /* can't mortalize here as every nextstate in the code + * block frees temps */ + SAVEFREESV(spill); + } - argi = 0; - items = n_args; + fill = (int)AvFILL(spill); + av_extend(spill, fill + count); + for(i = 0; i < count; i++) + (void)av_store(spill, ++fill, + newSVsv(PL_stack_base[i + 1])); } - - for(i = 0; i < count; i++) - stack[reti++] = newSVsv(PL_stack_sp[i - count + 1]); + else + for(i = 0; i < count; i++) + stack[reti++] = newSVsv(PL_stack_base[i + 1]); } + + if (spill) + /* the POP_MULTICALL will trigger the SAVEFREESV above; + * keep it alive it on the temps stack instead */ + SvREFCNT_inc_simple_void_NN(spill); + sv_2mortal((SV*)spill); + POP_MULTICALL; + if (spill) { + int n = (int)AvFILL(spill) + 1; + SP = &ST(reti - 1); + EXTEND(SP, n); + for (i = 0; i < n; i++) + *++SP = *av_fetch(spill, i, FALSE); + reti += n; + av_clear(spill); + } + if(ret_gimme == G_ARRAY) for(i = 0; i < reti; i++) - sv_2mortal(stack[i]); + sv_2mortal(ST(i)); } else #endif diff --git a/cpan/Scalar-List-Utils/lib/List/Util.pm b/cpan/Scalar-List-Utils/lib/List/Util.pm index 47324ca065..4a03af815a 100644 --- a/cpan/Scalar-List-Utils/lib/List/Util.pm +++ b/cpan/Scalar-List-Utils/lib/List/Util.pm @@ -15,7 +15,7 @@ our @EXPORT_OK = qw( all any first min max minstr maxstr none notall product reduce sum sum0 shuffle uniq uniqnum uniqstr pairs unpairs pairkeys pairvalues pairmap pairgrep pairfirst ); -our $VERSION = "1.47"; +our $VERSION = "1.48"; our $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -149,6 +149,9 @@ instead, as it can short-circuit after the first true result. # at least one string has more than 10 characters } +Note: Due to XS issues the block passed may be able to access the outer @_ +directly. This is not intentional and will break under debugger. + =head2 all my $bool = all { BLOCK } @list; @@ -160,6 +163,9 @@ make the C<BLOCK> return true. If any element returns false, then it returns false. If the C<BLOCK> never returns false or the C<@list> was empty then it returns true. +Note: Due to XS issues the block passed may be able to access the outer @_ +directly. This is not intentional and will break under debugger. + =head2 none =head2 notall @@ -174,6 +180,9 @@ Similar to L</any> and L</all>, but with the return sense inverted. C<none> returns true only if no value in the C<@list> causes the C<BLOCK> to return true, and C<notall> returns true only if not all of the values do. +Note: Due to XS issues the block passed may be able to access the outer @_ +directly. This is not intentional and will break under debugger. + =head2 first my $val = first { BLOCK } @list; diff --git a/cpan/Scalar-List-Utils/lib/List/Util/XS.pm b/cpan/Scalar-List-Utils/lib/List/Util/XS.pm index a9e191fc00..c870411578 100644 --- a/cpan/Scalar-List-Utils/lib/List/Util/XS.pm +++ b/cpan/Scalar-List-Utils/lib/List/Util/XS.pm @@ -3,7 +3,7 @@ use strict; use warnings; use List::Util; -our $VERSION = "1.47"; # FIXUP +our $VERSION = "1.48"; # FIXUP $VERSION = eval $VERSION; # FIXUP 1; diff --git a/cpan/Scalar-List-Utils/lib/Scalar/Util.pm b/cpan/Scalar-List-Utils/lib/Scalar/Util.pm index bd2b9ff802..ad36af3b60 100644 --- a/cpan/Scalar-List-Utils/lib/Scalar/Util.pm +++ b/cpan/Scalar-List-Utils/lib/Scalar/Util.pm @@ -17,7 +17,7 @@ our @EXPORT_OK = qw( dualvar isdual isvstring looks_like_number openhandle readonly set_prototype tainted ); -our $VERSION = "1.47"; +our $VERSION = "1.48"; $VERSION = eval $VERSION; require List::Util; # List::Util loads the XS diff --git a/cpan/Scalar-List-Utils/lib/Sub/Util.pm b/cpan/Scalar-List-Utils/lib/Sub/Util.pm index 48f775fadb..b4ec6ac75c 100644 --- a/cpan/Scalar-List-Utils/lib/Sub/Util.pm +++ b/cpan/Scalar-List-Utils/lib/Sub/Util.pm @@ -15,7 +15,7 @@ our @EXPORT_OK = qw( subname set_subname ); -our $VERSION = "1.47"; +our $VERSION = "1.48"; $VERSION = eval $VERSION; require List::Util; # as it has the XS diff --git a/cpan/Scalar-List-Utils/t/pair.t b/cpan/Scalar-List-Utils/t/pair.t index 81acf06594..e65123cc2c 100644 --- a/cpan/Scalar-List-Utils/t/pair.t +++ b/cpan/Scalar-List-Utils/t/pair.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 26; +use Test::More tests => 27; use List::Util qw(pairgrep pairfirst pairmap pairs unpairs pairkeys pairvalues); no warnings 'misc'; # avoid "Odd number of elements" warnings most of the time @@ -82,6 +82,16 @@ is_deeply( [ pairmap { my @l = (1) x 1000; "$a=$b" } one => 1, two => 2, three = [ "one=1", "two=2", "three=3" ], 'pairmap copes with stack movement' ); +{ + # do the pairmap and is_deeply as two separate statements to avoid + # the stack being extended before pairmap is called + my @a = pairmap { $a .. $b } + 1 => 3, 4 => 4, 5 => 6, 7 => 1998, 1999 => 2000; + my @exp; push @exp, $_ for 1..2000; + is_deeply( \@a, \@exp, + 'pairmap result has more elements than input' ); +} + is_deeply( [ pairs one => 1, two => 2, three => 3 ], [ [ one => 1 ], [ two => 2 ], [ three => 3 ] ], 'pairs' ); diff --git a/cpan/Time-Piece/Piece.pm b/cpan/Time-Piece/Piece.pm index 6dbf4d69c4..a3dfc744d4 100644 --- a/cpan/Time-Piece/Piece.pm +++ b/cpan/Time-Piece/Piece.pm @@ -20,7 +20,7 @@ our %EXPORT_TAGS = ( ':override' => 'internal', ); -our $VERSION = '1.31'; +our $VERSION = '1.3201'; bootstrap Time::Piece $VERSION; @@ -31,6 +31,9 @@ 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 $LOCALE; use constant { 'c_sec' => 0, @@ -96,11 +99,12 @@ sub parse { @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(_strftime("%s", timelocal(@components))); + return $class->new( timelocal(@components )); } sub _mktime { my ($class, $time, $islocal) = @_; + $class = eval { (ref $class) && (ref $class)->isa('Time::Piece') } ? ref $class : $class; @@ -456,31 +460,127 @@ sub month_last_day { return $MON_LAST[$_mon] + ($_mon == 1 ? _is_leap_year($year) : 0); } -#since %z and %Z are not portable lets just -#parse it out before calling native strftime -#(but only if we are in UTC time) -my %GMT_REPR = ( - '%z' => '+0000', - '%Z' => 'UTC', -); +my $trans_map_common = { + + '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; + }, + '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; + }, + '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; + }, +}; + +my $strftime_trans_map = { + %{$trans_map_common}, + + 'e' => sub { + my ( $format, $time ) = @_; + $format =~ s/%e/%d/ if $IS_WIN32; + return $format; + }, + 'D' => sub { + my ( $format, $time ) = @_; + $format =~ s/%D/%m\/%d\/%y/; + return $format; + }, + 'F' => sub { + my ( $format, $time ) = @_; + $format =~ s/%F/%Y-%m-%d/; + return $format; + }, + 'R' => sub { + my ( $format, $time ) = @_; + $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 ) = @_; + $format =~ s/%s/$time->[c_epoch]/; + return $format; + }, + 'T' => sub { + my ( $format, $time ) = @_; + $format =~ s/%T/%H:%M:%S/ if $IS_WIN32; + return $format; + }, + 'u' => sub { + my ( $format, $time ) = @_; + $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, $time ) = @_; + $format =~ s/%x/%a %d %b %Y/; + 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(@_) : '%a, %d %b %Y %H:%M:%S %Z'; - if (! $time->[c_islocal]) { - $format =~ s/(%.)/$GMT_REPR{$1} || $1/eg; - } + $format = _translate_format($format, $strftime_trans_map, $time); + + return $format unless $format =~ /%/; #if translate removes everything return _strftime($format, $time->epoch, $time->[c_islocal]); } +my $strptime_trans_map = { + %{$trans_map_common}, +}; + sub strptime { my $time = shift; my $string = shift; my $format = @_ ? shift(@_) : "%a, %d %b %Y %H:%M:%S %Z"; - my @vals = _strptime($string, $format); -# warn(sprintf("got vals: %d-%d-%d %d:%d:%d\n", reverse(@vals))); - return scalar $time->_mktime(\@vals, (ref($time) ? $time->[c_islocal] : 0)); + my $islocal = (ref($time) ? $time->[c_islocal] : 0); + my $locales = $LOCALE || &Time::Piece::_default_locale(); + $format = _translate_format($format, $strptime_trans_map); + my @vals = _strptime($string, $format, $islocal, $locales); +# warn(sprintf("got vals: %d-%d-%d %d:%d:%d\n", reverse(@vals[c_sec..c_year]))); + return scalar $time->_mktime(\@vals, $islocal); } sub day_list { @@ -488,6 +588,7 @@ sub day_list { my @old = @DAY_LIST; if (@_) { @DAY_LIST = @_; + &Time::Piece::_default_locale(); } return @old; } @@ -497,6 +598,7 @@ sub mon_list { my @old = @MON_LIST; if (@_) { @MON_LIST = @_; + &Time::Piece::_default_locale(); } return @old; } @@ -634,6 +736,132 @@ sub add_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]); +} + +#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 ) = @_; + + $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; + 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(); + + $locales->{PM} ||= ''; + $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 gloabl 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->{alt_month} = $locales->{month}; + + $locales->{PM} = 'PM'; + $locales->{AM} = 'AM'; + $locales->{pm} = 'pm'; + $locales->{am} = 'am'; + $locales->{c_fmt} = ''; + + $LOCALE = $locales; +} + +sub _locale { + return $LOCALE; +} + + 1; __END__ @@ -658,7 +886,7 @@ 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: -http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2000-01/msg00241.html +L<http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2000-01/msg00241.html> =head1 USAGE @@ -739,7 +967,8 @@ methods. Both wdayname (day) and monname (month) allow passing in a list to use to index the name of the days against. This can be useful if you need to implement some form of localisation without actually installing or -using locales. +using locales. Note that this is a global override and will affect +all Time::Piece instances. my @days = qw( Dimanche Lundi Merdi Mercredi Jeudi Vendredi Samedi ); @@ -757,6 +986,9 @@ And locally for months: print localtime->month(@months); +Or to populate with your current system locale call: + Time::Piece->use_locale(); + =head2 Date Calculations It's possible to use simple addition and subtraction of objects: @@ -783,8 +1015,8 @@ days, weeks and years in that delta, using the Time::Seconds API. In addition to adding seconds, there are two APIs for adding months and years: - $t->add_months(6); - $t->add_years(5); + $t = $t->add_months(6); + $t = $t->add_years(5); The months and years can be negative for subtractions. Note that there is some "strange" behaviour when adding and subtracting months at the @@ -794,6 +1026,17 @@ subtracting a month from 2008-03-31 will not result in 2008-02-31 as this is an impossible date. Instead you will get 2008-03-02. This appears to be consistent with other date manipulation tools. +=head2 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". + =head2 Date Comparisons Date comparisons are also possible, using the full suite of "<", ">", @@ -818,7 +1061,34 @@ Outputs: For more information see "man strptime", which should be on all unix systems. -Alternatively look here: http://www.unix.com/man-page/FreeBSD/3/strftime/ +Alternatively look here: L<http://www.unix.com/man-page/FreeBSD/3/strftime/> + +=head3 CAVEAT %A, %a, %B, %b, and friends + +Time::Piece::strptime by default can only parse American English date names. +Meanwhile, Time::Piece->strftime() will return date names that use the current +configured system locale. This means dates returned by strftime might not be +able to be parsed by strptime. This is the default behavior and can be +overridden by calling Time::Piece->use_locale(). This builds a list of the +current locale's day and month names which strptime will use to parse with. +Note this is a global override and will affect all Time::Piece instances. + +For instance with a German locale: + + localtime->day_list(); + +Returns + + ( 'Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat' ) + +While: + + Time::Piece->use_locale(); + localtime->day_list(); + +Returns + + ( 'So', 'Mo', 'Di', 'Mi', 'Do', 'Fr', 'Sa' ) =head2 YYYY-MM-DDThh:mm:ss @@ -886,7 +1156,7 @@ as Perl. =head1 SEE ALSO -The excellent Calendar FAQ at http://www.tondering.dk/claus/calendar.html +The excellent Calendar FAQ at L<http://www.tondering.dk/claus/calendar.html> =head1 BUGS diff --git a/cpan/Time-Piece/Piece.xs b/cpan/Time-Piece/Piece.xs index 3441bd799b..8b3d43aadf 100644 --- a/cpan/Time-Piece/Piece.xs +++ b/cpan/Time-Piece/Piece.xs @@ -10,30 +10,6 @@ extern "C" { } #endif -/* XXX struct tm on some systems (SunOS4/BSD) contains extra (non POSIX) - * fields for which we don't have Configure support prior to Perl 5.8.0: - * char *tm_zone; -- abbreviation of timezone name - * long tm_gmtoff; -- offset from GMT in seconds - * To workaround core dumps from the uninitialised tm_zone we get the - * system to give us a reasonable struct to copy. This fix means that - * strftime uses the tm_zone and tm_gmtoff values returned by - * localtime(time()). That should give the desired result most of the - * time. But probably not always! - * - * This is a vestigial workaround for Perls prior to 5.8.0. We now - * rely on the initialization (still likely a workaround) in util.c. - */ -#if !defined(PERL_VERSION) || PERL_VERSION < 8 - -#if defined(HAS_GNULIBC) -# ifndef STRUCT_TM_HASZONE -# define STRUCT_TM_HASZONE -# else -# define USE_TM_GMTOFF -# endif -#endif - -#endif /* end of pre-5.8 */ #define DAYS_PER_YEAR 365 #define DAYS_PER_QYEAR (4*DAYS_PER_YEAR+1) @@ -48,26 +24,7 @@ extern "C" { #define YEAR_ADJUST (4*MONTH_TO_DAYS+1) /* as used here, the algorithm leaves Sunday as day 1 unless we adjust it */ #define WEEKDAY_BIAS 6 /* (1+6)%7 makes Sunday 0 again */ - -#if !defined(PERL_VERSION) || PERL_VERSION < 8 - -#ifdef STRUCT_TM_HASZONE -static void -my_init_tm(struct tm *ptm) /* see mktime, strftime and asctime */ -{ - Time_t now; - (void)time(&now); - Copy(localtime(&now), ptm, 1, struct tm); -} - -#else -# define my_init_tm(ptm) -#endif - -#else -/* use core version from util.c in 5.8.0 and later */ -# define my_init_tm init_tm -#endif +#define TP_BUF_SIZE 160 #ifdef WIN32 @@ -154,7 +111,7 @@ fix_win32_tzenv(void) crt_tz_env = ""; if (strcmp(perl_tz_env, crt_tz_env) != 0) { STRLEN perl_tz_env_len = strlen(perl_tz_env); - newenv = (char*)malloc((perl_tz_env_len + 4) * sizeof(char)); + newenv = (char*)malloc(perl_tz_env_len + 4); if (newenv != NULL) { /* putenv with old MS CRTs will cause a double free internally if you delete an env var with the CRT env that doesn't exist in Win32 env (perl %ENV only @@ -369,81 +326,19 @@ static char * _strptime(pTHX_ const char *, const char *, struct tm *, #define asizeof(a) (sizeof (a) / sizeof ((a)[0])) struct lc_time_T { - const char * mon[12]; - const char * month[12]; - const char * wday[7]; - const char * weekday[7]; - const char * X_fmt; - const char * x_fmt; - const char * c_fmt; - const char * am; - const char * pm; - const char * date_fmt; - const char * alt_month[12]; - const char * Ef_fmt; - const char * EF_fmt; + char * mon[12]; + char * month[12]; + char * wday[7]; + char * weekday[7]; + char * am; + char * pm; + char * AM; + char * PM; + char * alt_month[12]; }; -struct lc_time_T _time_localebuf; -int _time_using_locale; - -const struct lc_time_T _C_time_locale = { - { - "Jan", "Feb", "Mar", "Apr", "May", "Jun", - "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" - }, { - "January", "February", "March", "April", "May", "June", - "July", "August", "September", "October", "November", "December" - }, { - "Sun", "Mon", "Tue", "Wed", - "Thu", "Fri", "Sat" - }, { - "Sunday", "Monday", "Tuesday", "Wednesday", - "Thursday", "Friday", "Saturday" - }, - - /* X_fmt */ - "%H:%M:%S", - - /* - ** x_fmt - ** Since the C language standard calls for - ** "date, using locale's date format," anything goes. - ** Using just numbers (as here) makes Quakers happier; - ** it's also compatible with SVR4. - */ - "%m/%d/%y", - - /* - ** c_fmt (ctime-compatible) - ** Not used, just compatibility placeholder. - */ - NULL, - - /* am */ - "AM", - - /* pm */ - "PM", - - /* date_fmt */ - "%a %Ef %X %Z %Y", - - { - "January", "February", "March", "April", "May", "June", - "July", "August", "September", "October", "November", "December" - }, - - /* Ef_fmt - ** To determine short months / day order - */ - "%b %e", - - /* EF_fmt - ** To determine long months / day order - */ - "%B %e" -}; + +static struct lc_time_T _C_time_locale; #define Locale (&_C_time_locale) @@ -488,7 +383,7 @@ label: break; case '+': - buf = _strptime(aTHX_ buf, Locale->date_fmt, tm, got_GMT); + buf = _strptime(aTHX_ buf, "%c", tm, got_GMT); if (buf == 0) return 0; break; @@ -512,7 +407,8 @@ label: case 'c': /* NOTE: c_fmt is intentionally ignored */ - buf = _strptime(aTHX_ buf, "%a %Ef %T %Y", tm, got_GMT); + + buf = _strptime(aTHX_ buf, "%a %d %b %Y %I:%M:%S %p %Z", tm, got_GMT); if (buf == 0) return 0; break; @@ -536,10 +432,7 @@ label: goto label; case 'F': - case 'f': - if (!Ealternative) - break; - buf = _strptime(aTHX_ buf, (c == 'f') ? Locale->Ef_fmt : Locale->EF_fmt, tm, got_GMT); + buf = _strptime(aTHX_ buf, "%Y-%m-%d", tm, got_GMT); if (buf == 0) return 0; break; @@ -571,13 +464,13 @@ label: break; case 'X': - buf = _strptime(aTHX_ buf, Locale->X_fmt, tm, got_GMT); + buf = _strptime(aTHX_ buf, "%I:%M:%S %p", tm, got_GMT); if (buf == 0) return 0; break; case 'x': - buf = _strptime(aTHX_ buf, Locale->x_fmt, tm, got_GMT); + buf = _strptime(aTHX_ buf, "%a %d %b %Y", tm, got_GMT); if (buf == 0) return 0; break; @@ -664,12 +557,14 @@ label: break; case 'p': + case 'P': /* * XXX This is bogus if parsed before hour-related * specifiers. */ len = strlen(Locale->am); - if (strncasecmp(buf, Locale->am, len) == 0) { + if (strncasecmp(buf, Locale->am, len) == 0 || + strncasecmp(buf, Locale->AM, len) == 0) { if (tm->tm_hour > 12) return 0; if (tm->tm_hour == 12) @@ -679,7 +574,8 @@ label: } len = strlen(Locale->pm); - if (strncasecmp(buf, Locale->pm, len) == 0) { + if (strncasecmp(buf, Locale->pm, len) == 0 || + strncasecmp(buf, Locale->PM, len) == 0) { if (tm->tm_hour > 12) return 0; if (tm->tm_hour != 12) @@ -715,6 +611,7 @@ label: break; case 'U': + case 'V': case 'W': /* * XXX This is bogus, as we can not assume any valid @@ -739,16 +636,20 @@ label: ptr++; break; + case 'u': case 'w': if (!isdigit((unsigned char)*buf)) return 0; i = *buf - '0'; - if (i > 6) + if (i > 6 + (c == 'u')) return 0; + if (i == 7) + i = 0; tm->tm_wday = i; + buf++; if (*buf != 0 && isspace((unsigned char)*buf)) while (*ptr != 0 && !isspace((unsigned char)*ptr)) ptr++; @@ -856,8 +757,12 @@ label: errno = sverrno; buf = cp; memset(&mytm, 0, sizeof(mytm)); - my_init_tm(&mytm); /* XXX workaround - see my_init_tm() above */ - mytm = *gmtime(&t); + + if(*got_GMT == 1) + mytm = *localtime(&t); + else + mytm = *gmtime(&t); + tm->tm_sec = mytm.tm_sec; tm->tm_min = mytm.tm_min; tm->tm_hour = mytm.tm_hour; @@ -966,7 +871,7 @@ label: !!!! You must mortalize whatever push_common_tm put on stack yourself to avoid leaking !!!! */ -SV ** +static SV ** push_common_tm(pTHX_ SV ** SP, struct tm *mytm) { PUSHs(newSViv(mytm->tm_sec)); @@ -988,12 +893,12 @@ push_common_tm(pTHX_ SV ** SP, struct tm *mytm) return -- none, after calling return_11part_tm, you must call "return;" no exceptions */ -void +static void return_11part_tm(pTHX_ SV ** SP, struct tm *mytm) { my_mini_mktime(mytm); - /* warn("tm: %d-%d-%d %d:%d:%d\n", mytm.tm_year, mytm.tm_mon, mytm.tm_mday, mytm.tm_hour, mytm.tm_min, mytm.tm_sec); */ + /* warn("tm: %d-%d-%d %d:%d:%d\n", mytm->tm_year, mytm->tm_mon, mytm->tm_mday, mytm->tm_hour, mytm->tm_min, mytm->tm_sec); */ EXTEND(SP, 11); SP = push_common_tm(aTHX_ SP, mytm); /* epoch */ @@ -1013,6 +918,36 @@ return_11part_tm(pTHX_ SV ** SP, struct tm *mytm) return; } + +static void _populate_C_time_locale(pTHX_ HV* locales ) +{ + AV* alt_names = (AV *) SvRV( *hv_fetch(locales, "alt_month", strlen("alt_month"), 0) ); + AV* long_names = (AV *) SvRV( *hv_fetch(locales, "month", strlen("month"), 0) ); + AV* short_names = (AV *) SvRV( *hv_fetch(locales, "mon", strlen("mon"), 0) ); + int i; + + for (i = 0; i < 1 + (int) av_len( long_names ); i++) { + Locale->alt_month[i] = SvPV_nolen( (SV *) *av_fetch(alt_names, i, 0) ); + Locale->month[i] = SvPV_nolen( (SV *) *av_fetch(long_names, i, 0) ); + Locale->mon[i] = SvPV_nolen( (SV *) *av_fetch(short_names, i, 0) ); + } + + long_names = (AV *) SvRV( *hv_fetch(locales, "weekday", strlen("weekday"), 0) ); + short_names = (AV *) SvRV( *hv_fetch(locales, "wday", strlen("wday"), 0) ); + + for (i = 0; i < 1 + (int) av_len( long_names ); i++) { + Locale->wday[i] = SvPV_nolen( (SV *) *av_fetch(short_names, i, 0) ); + Locale->weekday[i] = SvPV_nolen( (SV *) *av_fetch(long_names, i, 0) ); + } + + Locale->am = SvPV_nolen( (SV *) *hv_fetch(locales, "am", strlen("am"), 0) ); + Locale->pm = SvPV_nolen( (SV *) *hv_fetch(locales, "pm", strlen("pm"), 0) ); + Locale->AM = SvPV_nolen( (SV *) *hv_fetch(locales, "AM", strlen("AM"), 0) ); + Locale->PM = SvPV_nolen( (SV *) *hv_fetch(locales, "PM", strlen("PM"), 0) ); + + return; +} + MODULE = Time::Piece PACKAGE = Time::Piece PROTOTYPES: ENABLE @@ -1024,7 +959,7 @@ _strftime(fmt, epoch, islocal = 1) int islocal CODE: { - char tmpbuf[128]; + char tmpbuf[TP_BUF_SIZE]; struct tm mytm; size_t len; @@ -1033,7 +968,7 @@ _strftime(fmt, epoch, islocal = 1) else mytm = *gmtime(&epoch); - len = strftime(tmpbuf, sizeof tmpbuf, fmt, &mytm); + len = strftime(tmpbuf, TP_BUF_SIZE, fmt, &mytm); /* ** The following is needed to handle to the situation where ** tmpbuf overflows. Basically we want to allocate a buffer @@ -1048,12 +983,12 @@ _strftime(fmt, epoch, islocal = 1) ** If there is a better way to make it portable, go ahead by ** all means. */ - if ((len > 0 && len < sizeof(tmpbuf)) || (len == 0 && *fmt == '\0')) + if ((len > 0 && len < TP_BUF_SIZE) || (len == 0 && *fmt == '\0')) ST(0) = sv_2mortal(newSVpv(tmpbuf, len)); else { /* Possibly buf overflowed - try again with a bigger buf */ int fmtlen = strlen(fmt); - int bufsize = fmtlen + sizeof(tmpbuf); + int bufsize = fmtlen + TP_BUF_SIZE; char* buf; int buflen; @@ -1088,26 +1023,40 @@ _tzset() return; /* skip XSUBPP's PUTBACK */ void -_strptime ( string, format ) +_strptime ( string, format, got_GMT, SV* localization ) char * string char * format + int got_GMT PREINIT: struct tm mytm; - time_t t; char * remainder; - int got_GMT; + HV * locales; PPCODE: - t = 0; - mytm = *gmtime(&t); + memset(&mytm, 0, sizeof(mytm)); + + // sensible defaults. + mytm.tm_mday = 1; + mytm.tm_year = 70; + mytm.tm_wday = 4; mytm.tm_isdst = -1; /* -1 means we don't know */ - got_GMT = 0; + + if( SvTYPE(SvRV( localization )) == SVt_PVHV ){ + locales = (HV *)SvRV(localization); + } + else{ + croak("_strptime requires a Hash Reference of locales"); + } + + //populate our locale data struct (used for %[AaBbPp] flags) + _populate_C_time_locale(aTHX_ locales ); remainder = (char *)_strptime(aTHX_ string, format, &mytm, &got_GMT); if (remainder == NULL) { croak("Error parsing time"); } if (*remainder != '\0') { - warn("garbage at end of string in strptime: %s", remainder); + warn("Garbage at end of string in strptime: %s", remainder); + warn("Perhaps a format flag did not match the actual input?"); } return_11part_tm(aTHX_ SP, &mytm); @@ -1143,13 +1092,13 @@ _crt_localtime(time_t sec) else mytm = *localtime(&sec); /* Need to get: $s,$n,$h,$d,$m,$y */ - EXTEND(SP, 9); + EXTEND(SP, 10); SP = push_common_tm(aTHX_ SP, &mytm); PUSHs(newSViv(mytm.tm_isdst)); PUTBACK; { SV ** endsp = SP; /* the SV * under SP needs to be mortaled */ - SP -= (9 - 1); /* subtract 0 based count of SVs to mortal */ + SP -= (10 - 1); /* subtract 0 based count of SVs to mortal */ /* mortal target of SP, then increment before function call so SP is already calculated before next comparison to not stall CPU */ do { @@ -1157,3 +1106,61 @@ _crt_localtime(time_t sec) } while(SP <= endsp); } return; + +SV* +_get_localization() + INIT: + HV* locales = newHV(); + AV* wdays = newAV(); + AV* weekdays = newAV(); + AV* mons = newAV(); + AV* months = newAV(); + SV** tmp; + size_t len; + char buf[TP_BUF_SIZE]; + size_t i; + time_t t = 1325386800; /*1325386800 = Sun, 01 Jan 2012 03:00:00 GMT*/ + struct tm mytm = *gmtime(&t); + CODE: + + for(i = 0; i < 7; ++i){ + + len = strftime(buf, TP_BUF_SIZE, "%a", &mytm); + av_push(wdays, (SV *) newSVpvn(buf, len)); + + len = strftime(buf, TP_BUF_SIZE, "%A", &mytm); + av_push(weekdays, (SV *) newSVpvn(buf, len)); + + ++mytm.tm_wday; + } + + for(i = 0; i < 12; ++i){ + + len = strftime(buf, TP_BUF_SIZE, "%b", &mytm); + av_push(mons, (SV *) newSVpvn(buf, len)); + + len = strftime(buf, TP_BUF_SIZE, "%B", &mytm); + av_push(months, (SV *) newSVpvn(buf, len)); + + ++mytm.tm_mon; + } + + tmp = hv_store(locales, "wday", strlen("wday"), newRV_noinc((SV *) wdays), 0); + tmp = hv_store(locales, "weekday", strlen("weekday"), newRV_noinc((SV *) weekdays), 0); + tmp = hv_store(locales, "mon", strlen("mon"), newRV_noinc((SV *) mons), 0); + tmp = hv_store(locales, "month", strlen("month"), newRV_noinc((SV *) months), 0); + tmp = hv_store(locales, "alt_month", strlen("alt_month"), newRV((SV *) months), 0); + + len = strftime(buf, TP_BUF_SIZE, "%p", &mytm); + tmp = hv_store(locales, "AM", strlen("AM"), newSVpvn(buf,len), 0); + mytm.tm_hour = 18; + len = strftime(buf, TP_BUF_SIZE, "%p", &mytm); + tmp = hv_store(locales, "PM", strlen("PM"), newSVpvn(buf,len), 0); + + if(tmp == NULL || !SvOK( (SV *) *tmp)){ + croak("Failed to get localization."); + } + + RETVAL = newRV_noinc((SV *)locales); + OUTPUT: + RETVAL diff --git a/cpan/Time-Piece/Seconds.pm b/cpan/Time-Piece/Seconds.pm index 965e3a6e50..af22ee299d 100644 --- a/cpan/Time-Piece/Seconds.pm +++ b/cpan/Time-Piece/Seconds.pm @@ -1,7 +1,7 @@ package Time::Seconds; use strict; -our $VERSION = '1.31'; +our $VERSION = '1.3201'; use Exporter 5.57 'import'; @@ -145,6 +145,13 @@ sub years { $s->days / 365.24225; } +sub _counted_objects { + my ($n, $counted) = @_; + my $number = sprintf("%d", $n); # does a "floor" + $counted .= 's' if 1 != $number; + return ($number, $counted); +} + sub pretty { my $s = shift; my $str = ""; @@ -155,19 +162,19 @@ sub pretty { if ($s >= ONE_MINUTE) { if ($s >= ONE_HOUR) { if ($s >= ONE_DAY) { - my $days = sprintf("%d", $s->days); # does a "floor" - $str .= $days . " days, "; + my ($days, $sd) = _counted_objects($s->days, "day"); + $str .= "$days $sd, "; $s -= ($days * ONE_DAY); } - my $hours = sprintf("%d", $s->hours); - $str .= $hours . " hours, "; + my ($hours, $sh) = _counted_objects($s->hours, "hour"); + $str .= "$hours $sh, "; $s -= ($hours * ONE_HOUR); } - my $mins = sprintf("%d", $s->minutes); - $str .= $mins . " minutes, "; + my ($mins, $sm) = _counted_objects($s->minutes, "minute"); + $str .= "$mins $sm, "; $s -= ($mins * ONE_MINUTE); } - $str .= $s->seconds . " seconds"; + $str .= join " ", _counted_objects($s->seconds, "second"); return $str; } diff --git a/cpan/Time-Piece/t/02core.t b/cpan/Time-Piece/t/02core.t index 29330587d3..8de1426176 100644 --- a/cpan/Time-Piece/t/02core.t +++ b/cpan/Time-Piece/t/02core.t @@ -1,4 +1,4 @@ -use Test::More tests => 102; +use Test::More tests => 100; my $is_win32 = ($^O =~ /Win32/); my $is_qnx = ($^O eq 'qnx'); @@ -18,9 +18,6 @@ is($t->mday, 29); is($t->day_of_month, 29); is($t->mon, 2); is($t->_mon, 1); -is($t->monname, 'Feb'); -is($t->month, 'Feb'); -is($t->fullmonth, 'February'); is($t->year, 2000); is($t->_year, 100); is($t->yy, '00'); @@ -28,9 +25,6 @@ is($t->yy, '00'); cmp_ok($t->wday, '==', 3); cmp_ok($t->_wday, '==', 2); cmp_ok($t->day_of_week, '==', 2); -cmp_ok($t->wdayname, 'eq', 'Tue'); -cmp_ok($t->day, 'eq', 'Tue'); -cmp_ok($t->fullday, 'eq', 'Tuesday'); cmp_ok($t->yday, '==', 59); cmp_ok($t->day_of_year, '==', 59); @@ -76,15 +70,8 @@ cmp_ok($t->week, '==', 9); # 20 or 19, is fun, too..as far as I can read SUSv2 it should be 20.) cmp_ok($t->strftime('%d'), '==', 29); -SKIP: { - skip "can't strftime %D, %R, %T or %e on Win32", 1 if $is_win32; - cmp_ok($t->strftime('%D'), 'eq', '02/29/00'); # Yech! -} -SKIP:{ - skip "can't strftime %D, %R, %T or %e on Win32", 1 if $is_win32; - skip "can't strftime %e on QNX", 1 if $is_qnx; - cmp_ok($t->strftime('%e'), 'eq', '29'); # should test with < 10 -} +cmp_ok($t->strftime('%D'), 'eq', '02/29/00'); # Yech! +cmp_ok($t->strftime('%e'), 'eq', '29'); # should test with < 10 # %h is locale-dependent cmp_ok($t->strftime('%H'), 'eq', '12'); # should test with < 10 @@ -96,17 +83,11 @@ cmp_ok($t->strftime('%M'), 'eq', '34'); # should test with < 10 # %p, %P, and %r are not widely implemented, # and are possibly unportable (am or AM or a.m., and so on) -SKIP: { - skip "can't strftime %R on Win32 or QNX", 1 if $is_win32 or $is_qnx; - cmp_ok($t->strftime('%R'), 'eq', '12:34'); # should test with > 12 -} +cmp_ok($t->strftime('%R'), 'eq', '12:34'); # should test with > 12 ok($t->strftime('%S') eq '56'); # should test with < 10 -SKIP: { - skip "can't strftime %T on Win32", 1 if $is_win32; - cmp_ok($t->strftime('%T'), 'eq', '12:34:56'); # < 12 and > 12 -} +cmp_ok($t->strftime('%T'), 'eq', '12:34:56'); # < 12 and > 12 # There are bugs in the implementation of %u in many platforms. # (e.g. Linux seems to think, despite the man page, that %u @@ -115,7 +96,7 @@ SKIP: { cmp_ok($t->strftime('%U'), 'eq', '09'); # Sun cmp Mon SKIP: { - skip "can't strftime %V on Win32 or QNX or VOS", 1 if $is_win32 or $is_qnx or $is_vos; + skip "can't strftime %V on QNX or VOS", 1 if $is_qnx or $is_vos; # is this test really broken on Mac OS? -- rjbs, 2006-02-08 cmp_ok($t->strftime('%V'), 'eq', '09'); # Sun cmp Mon } @@ -143,6 +124,7 @@ cmp_ok($t->date_separator, 'eq', '-'); $t->date_separator("/"); cmp_ok($t->date_separator, 'eq', '/'); +cmp_ok(Time::Piece::date_separator(), 'eq', '/'); cmp_ok($t->ymd, 'eq', '2000/02/29'); $t->date_separator("-"); @@ -151,6 +133,7 @@ cmp_ok($t->hms("."), 'eq', '12.34.56'); $t->time_separator("."); cmp_ok($t->time_separator, 'eq', '.'); +cmp_ok(Time::Piece::time_separator(), 'eq', '.'); cmp_ok($t->hms, 'eq', '12.34.56'); $t->time_separator(":"); @@ -168,7 +151,8 @@ cmp_ok($t->day, 'eq', "Merdi"); $t->day_list(@days); -cmp_ok($t->day, 'eq', "Tue"); +my @nmdays = Time::Piece::day_list(); +is_deeply (\@nmdays, \@days); my @months = $t->mon_list(); @@ -184,6 +168,8 @@ cmp_ok($t->month, 'eq', "februari"); $t->mon_list(@months); cmp_ok($t->month, 'eq', "Feb"); +my @nmmonths = Time::Piece::mon_list(); +is_deeply (\@nmmonths, \@months); cmp_ok( $t->datetime(date => '/', T => ' ', time => '-'), @@ -233,20 +219,16 @@ cmp_ok( 951827696 ); -#from Time::Piece::Plus -#test reverse parsing -my $now = localtime(); -my $strp_format = "%Y-%m-%d %H:%M:%S"; - -my $now_str = $now->strftime($strp_format); - -my $now_parsed = $now->strptime($now_str, $strp_format); - -cmp_ok($now_parsed->epoch, '==', $now->epoch); -cmp_ok($now_parsed->strftime($strp_format), 'eq', $now->strftime($strp_format)); -cmp_ok($now_parsed->strftime(), 'eq', $now->strftime()); - my $s = Time::Seconds->new(-691050); is($s->pretty, 'minus 7 days, 23 hours, 57 minutes, 30 seconds'); +$s = Time::Seconds->new(-90061); +is($s->pretty, 'minus 1 day, 1 hour, 1 minute, 1 second'); + +$s = Time::Seconds->new(10); +is($s->pretty, '10 seconds'); +$s = Time::Seconds->new(130); +is($s->pretty, '2 minutes, 10 seconds'); +$s = Time::Seconds->new(7330); +is($s->pretty, '2 hours, 2 minutes, 10 seconds', "Format correct"); diff --git a/cpan/Time-Piece/t/02core_dst.t b/cpan/Time-Piece/t/02core_dst.t index 4e12fb6694..3f54fff233 100644 --- a/cpan/Time-Piece/t/02core_dst.t +++ b/cpan/Time-Piece/t/02core_dst.t @@ -1,4 +1,4 @@ -use Test::More tests => 60; +use Test::More tests => 56; my $is_win32 = ($^O =~ /Win32/); my $is_qnx = ($^O eq 'qnx'); @@ -25,9 +25,6 @@ is($t->mday, 9); is($t->day_of_month, 9); is($t->mon, 7); is($t->_mon, 6); -is($t->monname, 'Jul'); -is($t->month, 'Jul'); -is($t->fullmonth, 'July'); is($t->year, 2013); is($t->_year, 113); is($t->yy, '13'); @@ -35,9 +32,6 @@ is($t->yy, '13'); cmp_ok($t->wday, '==', 3); cmp_ok($t->_wday, '==', 2); cmp_ok($t->day_of_week, '==', 2); -cmp_ok($t->wdayname, 'eq', 'Tue'); -cmp_ok($t->day, 'eq', 'Tue'); -cmp_ok($t->fullday, 'eq', 'Tuesday'); cmp_ok($t->yday, '==', 189); cmp_ok($t->day_of_year, '==', 189); @@ -125,7 +119,7 @@ cmp_ok($t->month_last_day, '==', 31); # test more SKIP: { - skip "Extra tests for Linux, BSD only.", 6 unless $is_linux or $is_mac or $is_bsd; + skip "Extra tests for Linux, BSD only.", 8 unless $is_linux or $is_mac or $is_bsd; local $ENV{TZ} = "EST5EDT4"; Time::Piece::_tzset(); @@ -133,14 +127,13 @@ SKIP: { cmp_ok(scalar($lt->tzoffset), 'eq', '-14400'); cmp_ok($lt->strftime("%Y-%m-%d %H:%M:%S %Z"), 'eq', '2013-07-09 08:07:11 EDT'); like ($lt->strftime("%z"), qr/-0400|EDT/); #windows: %Z and %z are the same + is ($lt->strftime("%s"), 1373371631, 'Epoch output is the same with EDT'); $lt = localtime(1357733231); #2013-01-09T12:07:11 cmp_ok(scalar($lt->tzoffset), 'eq', '-18000'); cmp_ok($lt->strftime("%Y-%m-%d %H:%M:%S %Z"), 'eq', '2013-01-09 07:07:11 EST'); like ($lt->strftime("%z"), qr/-0500|EST/); + is ($lt->strftime("%s"), 1357733231, 'Epoch output is the same with EST'); } - - - diff --git a/cpan/Time-Piece/t/03compare.t b/cpan/Time-Piece/t/03compare.t index ccd8535829..ff3c706e29 100644 --- a/cpan/Time-Piece/t/03compare.t +++ b/cpan/Time-Piece/t/03compare.t @@ -1,5 +1,5 @@ -use Test; -BEGIN { plan tests => 5 } +use Test::More; +BEGIN { plan tests => 11 } use Time::Piece; my @t = ('2002-01-01 00:00', @@ -8,12 +8,18 @@ my @t = ('2002-01-01 00:00', @t = map Time::Piece->strptime($_, '%Y-%m-%d %H:%M'), @t; ok($t[0] < $t[1]); +ok($t[0] < $t[1]->epoch); ok($t[0] != $t[1]); ok($t[0] == $t[0]); +ok($t[0] == $t[0]->epoch); ok($t[0] != $t[1]); ok($t[0] <= $t[1]); +ok($t[0] <= $t[1]->epoch); +is($t[0] cmp $t[1], -1); +is($t[1] cmp $t[0], 1); +is($t[0] cmp $t[0], 0); diff --git a/cpan/Time-Piece/t/07arith.t b/cpan/Time-Piece/t/07arith.t index 7f16bd13ae..58ca17b3bc 100644 --- a/cpan/Time-Piece/t/07arith.t +++ b/cpan/Time-Piece/t/07arith.t @@ -1,6 +1,6 @@ -use Test::More tests => 25; +use Test::More tests => 43; -BEGIN { use_ok('Time::Piece'); } +BEGIN { use_ok('Time::Piece'); use_ok('Time::Seconds'); } ok(1); @@ -45,3 +45,39 @@ my $t9 = $t->add_months(-13); is($t9->year, 2008); is($t9->mon, 12); is($t9->mday, 1); + +eval { $t->add_months(); }; +like($@, qr/add_months requires a number of months/); + +# Tests for Time::Seconds start here +my $s = $t - $t7; +is($s->minutes, 44640); +is($s->hours, 744); +is($s->days, 31); +is(int($s->weeks), 4); +is(int($s->months), 1); +is(int($s->years), 0); + +$s2 = $s->copy; +is($s2->minutes, 44640, 'Copy Time::Seconds object'); +$s2 = $s->copy + 60; +is($s2->minutes, 44641, 'Add integer to Time::Seconds object'); +$s2 += ONE_HOUR; +is($s2->minutes, 44701, 'Add exported constant to Time::Seconds object'); +$s2 += $s2; +is($s2->minutes, 89402, 'Add one Time::Seconds object to another'); + +$s2 += 300 * ONE_DAY; +is(int($s2->financial_months), 12); +is(int($s2->months), 11); + +$s2 = Time::Seconds->new(); +is($s2->seconds, 0, 'Empty Time::Seconds constructor is 0s'); +my $s3 = Time::Seconds->new(10); +$s2 = $s2 + $s3; +is($s2->seconds, 10, 'Add 2 Time::Seconds objects'); +$s2 -= $s3; +is($s2->seconds, 0, 'Subtract one Time::Seconds object from another'); + +eval { $s2 = $s2 + $t; }; +like($@, qr/Can't use non Seconds object in operator overload/); -- Perl5 Master Repository
