diff options
author | Karl Berry <karl@freefriends.org> | 2017-04-18 23:10:57 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2017-04-18 23:10:57 +0000 |
commit | 40b4b6e177c62a14c166dbba6adf3abc415af4b2 (patch) | |
tree | 2996bf29509c806bd8064fb6cf38092c1b375ff8 /Master/tlpkg/tlperl/lib/Time | |
parent | 8e743c86b6872f30b7a35c72aa944455157d4b3f (diff) |
tlperl 5.24.1 from siep
git-svn-id: svn://tug.org/texlive/trunk@43914 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Time')
-rw-r--r-- | Master/tlpkg/tlperl/lib/Time/HiRes.pm | 33 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/Time/Piece.pm | 90 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/Time/Seconds.pm | 76 |
3 files changed, 112 insertions, 87 deletions
diff --git a/Master/tlpkg/tlperl/lib/Time/HiRes.pm b/Master/tlpkg/tlperl/lib/Time/HiRes.pm index cf64bc1fbba..ad9a65c99d2 100644 --- a/Master/tlpkg/tlperl/lib/Time/HiRes.pm +++ b/Master/tlpkg/tlperl/lib/Time/HiRes.pm @@ -12,8 +12,13 @@ our @EXPORT = qw( ); our @EXPORT_OK = qw (usleep sleep ualarm alarm gettimeofday time tv_interval getitimer setitimer nanosleep clock_gettime clock_getres clock clock_nanosleep - CLOCK_HIGHRES CLOCK_MONOTONIC CLOCK_PROCESS_CPUTIME_ID - CLOCK_REALTIME CLOCK_SOFTTIME CLOCK_THREAD_CPUTIME_ID + CLOCK_BOOTTIME CLOCK_HIGHRES + CLOCK_MONOTONIC CLOCK_MONOTONIC_COARSE + CLOCK_MONOTONIC_PRECISE CLOCK_MONOTONIC_RAW + CLOCK_PROCESS_CPUTIME_ID + CLOCK_REALTIME CLOCK_REALTIME_COARSE + CLOCK_REALTIME_FAST CLOCK_REALTIME_PRECISE + CLOCK_SECOND CLOCK_SOFTTIME CLOCK_THREAD_CPUTIME_ID CLOCK_TIMEOFDAY CLOCKS_PER_SEC ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF ITIMER_REALPROF TIMER_ABSTIME @@ -23,7 +28,7 @@ our @EXPORT_OK = qw (usleep sleep ualarm alarm gettimeofday time tv_interval stat lstat ); -our $VERSION = '1.9726'; +our $VERSION = '1.9733'; our $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -115,7 +120,8 @@ Time::HiRes - High resolution alarm, sleep, gettimeofday, interval timers getitimer ($which); use Time::HiRes qw( clock_gettime clock_getres clock_nanosleep - ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF ITIMER_REALPROF ); + ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF + ITIMER_REALPROF ); $realtime = clock_gettime(CLOCK_REALTIME); $resolution = clock_getres(CLOCK_REALTIME); @@ -356,6 +362,13 @@ specified by C<$which>. All implementations that support POSIX high resolution timers are supposed to support at least the C<$which> value of C<CLOCK_REALTIME>, see L</clock_gettime>. +B<NOTE>: the resolution returned may be highly optimistic. Even if +the resolution is high (a small number), all it means is that you'll +be able to specify the arguments to clock_gettime() and clock_nanosleep() +with that resolution. The system might not actually be able to measure +events at that resolution, and the various overheads and the overall system +load are certain to affect any timings. + =item clock_nanosleep ( $which, $nanoseconds, $flags = 0) Sleeps for the number of nanoseconds (1e9ths of a second) specified. @@ -510,7 +523,7 @@ modglobal hash: name C prototype --------------- ---------------------- - Time::NVtime double (*)() + Time::NVtime NV (*)() Time::U2time void (*)(pTHX_ UV ret[2]) Both functions return equivalent information (like C<gettimeofday>) @@ -521,12 +534,12 @@ VMS have emulations for it.) Here is an example of using C<NVtime> from C: - double (*myNVtime)(); /* Returns -1 on failure. */ + NV (*myNVtime)(); /* Returns -1 on failure. */ SV **svp = hv_fetch(PL_modglobal, "Time::NVtime", 12, 0); if (!svp) croak("Time::HiRes is required"); if (!SvIOK(*svp)) croak("Time::NVtime isn't a function pointer"); - myNVtime = INT2PTR(double(*)(), SvIV(*svp)); - printf("The current time is: %f\n", (*myNVtime)()); + myNVtime = INT2PTR(NV(*)(), SvIV(*svp)); + printf("The current time is: %" NVff "\n", (*myNVtime)()); =head1 DIAGNOSTICS @@ -573,6 +586,10 @@ might help in this (in case your system supports CLOCK_MONOTONIC). Some systems have APIs but not implementations: for example QNX and Haiku have the interval timer APIs but not the functionality. +In OS X clock_getres(), clock_gettime() and clock_nanosleep() are +emulated using the Mach timers; as a side effect of being emulated +the CLOCK_REALTIME and CLOCK_MONOTONIC are the same timer. + =head1 SEE ALSO Perl modules L<BSD::Resource>, L<Time::TAI64>. diff --git a/Master/tlpkg/tlperl/lib/Time/Piece.pm b/Master/tlpkg/tlperl/lib/Time/Piece.pm index aaf63eebb78..6dbf4d69c44 100644 --- a/Master/tlpkg/tlperl/lib/Time/Piece.pm +++ b/Master/tlpkg/tlperl/lib/Time/Piece.pm @@ -2,13 +2,14 @@ package Time::Piece; use strict; -require Exporter; require DynaLoader; use Time::Seconds; use Carp; use Time::Local; -our @ISA = qw(Exporter DynaLoader); +our @ISA = qw(DynaLoader); + +use Exporter (); our @EXPORT = qw( localtime @@ -19,7 +20,7 @@ our %EXPORT_TAGS = ( ':override' => 'internal', ); -our $VERSION = '1.29'; +our $VERSION = '1.31'; bootstrap Time::Piece $VERSION; @@ -31,17 +32,19 @@ my @FULLMON_LIST = qw(January February March April May June July my @DAY_LIST = qw(Sun Mon Tue Wed Thu Fri Sat); my @FULLDAY_LIST = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday); -use constant 'c_sec' => 0; -use constant 'c_min' => 1; -use constant 'c_hour' => 2; -use constant 'c_mday' => 3; -use constant 'c_mon' => 4; -use constant 'c_year' => 5; -use constant 'c_wday' => 6; -use constant 'c_yday' => 7; -use constant 'c_isdst' => 8; -use constant 'c_epoch' => 9; -use constant 'c_islocal' => 10; +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') }; @@ -62,9 +65,9 @@ sub gmtime { sub new { my $class = shift; my ($time) = @_; - + my $self; - + if (defined($time)) { $self = $class->localtime($time); } @@ -74,7 +77,7 @@ sub new { else { $self = $class->localtime(); } - + return bless $self, ref($class) || $class; } @@ -82,6 +85,10 @@ sub parse { my $proto = shift; my $class = ref($proto) || $proto; my @components; + + warnings::warnif("deprecated", + "parse() is deprecated, use strptime() instead."); + if (@_ > 1) { @components = @_; } @@ -89,7 +96,7 @@ 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", @components)); + return $class->new(_strftime("%s", timelocal(@components))); } sub _mktime { @@ -98,7 +105,9 @@ sub _mktime { ? ref $class : $class; if (ref($time)) { - $time->[c_epoch] = undef; + my @tm_parts = (@{$time}[c_sec .. c_mon], $time->[c_year]+1900); + $time->[c_epoch] = $islocal ? timelocal(@tm_parts) : timegm(@tm_parts); + return wantarray ? @$time : bless [@$time[0..9], $islocal], $class; } _tzset(); @@ -122,13 +131,13 @@ sub export { no warnings 'redefine'; *{$to . "::$method"} = $_special_exports{$method}->($class); } else { - $class->SUPER::export($to, $method); + $class->Exporter::export($to, $method); } } } sub import { - # replace CORE::GLOBAL localtime and gmtime if required + # replace CORE::GLOBAL localtime and gmtime if passed :override my $class = shift; my %params; map($params{$_}++,@_,@EXPORT); @@ -136,7 +145,7 @@ sub import { $class->export('CORE::GLOBAL', keys %params); } else { - $class->export((caller)[0], keys %params); + $class->export(scalar caller, keys %params); } } @@ -279,7 +288,7 @@ sub isdst { # Thanks to Tony Olekshy <olekshy@cs.ualberta.ca> for this algorithm sub tzoffset { my $time = shift; - + return Time::Seconds->new(0) unless $time->[c_islocal]; my $epoch = $time->epoch; @@ -447,19 +456,22 @@ 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', +); + sub strftime { my $time = shift; - my $tzname = $time->[c_islocal] ? '%Z' : 'UTC'; - my $format = @_ ? shift(@_) : "%a, %d %b %Y %H:%M:%S $tzname"; - if (!defined $time->[c_wday]) { - if ($time->[c_islocal]) { - return _strftime($format, CORE::localtime($time->epoch)); - } - else { - return _strftime($format, CORE::gmtime($time->epoch)); - } + my $format = @_ ? shift(@_) : '%a, %d %b %Y %H:%M:%S %Z'; + if (! $time->[c_islocal]) { + $format =~ s/(%.)/$GMT_REPR{$1} || $1/eg; } - return _strftime($format, (@$time)[c_sec..c_isdst]); + + return _strftime($format, $time->epoch, $time->[c_islocal]); } sub strptime { @@ -550,7 +562,7 @@ sub subtract { # to override this function. return $rhs - "$time"; } - + if (UNIVERSAL::isa($rhs, 'Time::Piece')) { return Time::Seconds->new($time->epoch - $rhs->epoch); } @@ -592,9 +604,9 @@ sub compare { 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 < 0) { @@ -607,10 +619,10 @@ sub add_months { $num_years = int($final_month / 12); } $num_years-- if ($final_month < 0); - + $final_month = $final_month % 12; } - + my @vals = _mini_mktime($time->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])); @@ -701,7 +713,7 @@ following methods are available on the object: $t->week # week number (ISO 8601) - $t->is_leap_year # true if it its + $t->is_leap_year # true if it's a leap year $t->month_last_day # 28-31 $t->time_separator($s) # set the default separator (default ":") diff --git a/Master/tlpkg/tlperl/lib/Time/Seconds.pm b/Master/tlpkg/tlperl/lib/Time/Seconds.pm index 8e5b52b269f..965e3a6e502 100644 --- a/Master/tlpkg/tlperl/lib/Time/Seconds.pm +++ b/Master/tlpkg/tlperl/lib/Time/Seconds.pm @@ -1,53 +1,49 @@ package Time::Seconds; use strict; -use vars qw/@EXPORT @EXPORT_OK/; -our $VERSION = '1.29'; +our $VERSION = '1.31'; use Exporter 5.57 'import'; -@EXPORT = qw( - ONE_MINUTE - ONE_HOUR - ONE_DAY - ONE_WEEK +our @EXPORT = qw( + ONE_MINUTE + ONE_HOUR + ONE_DAY + ONE_WEEK ONE_MONTH - ONE_REAL_MONTH ONE_YEAR - ONE_REAL_YEAR ONE_FINANCIAL_MONTH - LEAP_YEAR + LEAP_YEAR NON_LEAP_YEAR ); -@EXPORT_OK = qw(cs_sec cs_mon); - -use constant ONE_MINUTE => 60; -use constant ONE_HOUR => 3_600; -use constant ONE_DAY => 86_400; -use constant ONE_WEEK => 604_800; -use constant ONE_MONTH => 2_629_744; # ONE_YEAR / 12 -use constant ONE_REAL_MONTH => '1M'; -use constant ONE_YEAR => 31_556_930; # 365.24225 days -use constant ONE_REAL_YEAR => '1Y'; -use constant ONE_FINANCIAL_MONTH => 2_592_000; # 30 days -use constant LEAP_YEAR => 31_622_400; # 366 * ONE_DAY -use constant NON_LEAP_YEAR => 31_536_000; # 365 * ONE_DAY - -# hacks to make Time::Piece compile once again -use constant cs_sec => 0; -use constant cs_mon => 1; - -use overload - 'fallback' => 'undef', - '0+' => \&seconds, - '""' => \&seconds, - '<=>' => \&compare, - '+' => \&add, - '-' => \&subtract, - '-=' => \&subtract_from, - '+=' => \&add_to, - '=' => \© +our @EXPORT_OK = qw(cs_sec cs_mon); + +use constant { + ONE_MINUTE => 60, + ONE_HOUR => 3_600, + ONE_DAY => 86_400, + ONE_WEEK => 604_800, + ONE_MONTH => 2_629_744, # ONE_YEAR / 12 + ONE_YEAR => 31_556_930, # 365.24225 days + ONE_FINANCIAL_MONTH => 2_592_000, # 30 days + LEAP_YEAR => 31_622_400, # 366 * ONE_DAY + NON_LEAP_YEAR => 31_536_000, # 365 * ONE_DAY + # hacks to make Time::Piece compile once again + cs_sec => 0, + cs_mon => 1, +}; + +use overload + 'fallback' => 'undef', + '0+' => \&seconds, + '""' => \&seconds, + '<=>' => \&compare, + '+' => \&add, + '-' => \&subtract, + '-=' => \&subtract_from, + '+=' => \&add_to, + '=' => \© sub new { my $class = shift; @@ -229,8 +225,8 @@ The following methods are available: $val->hours; $val->days; $val->weeks; - $val->months; - $val->financial_months; # 30 days + $val->months; + $val->financial_months; # 30 days $val->years; $val->pretty; # gives English representation of the delta |