summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Time
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2017-04-18 23:10:57 +0000
committerKarl Berry <karl@freefriends.org>2017-04-18 23:10:57 +0000
commit40b4b6e177c62a14c166dbba6adf3abc415af4b2 (patch)
tree2996bf29509c806bd8064fb6cf38092c1b375ff8 /Master/tlpkg/tlperl/lib/Time
parent8e743c86b6872f30b7a35c72aa944455157d4b3f (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.pm33
-rw-r--r--Master/tlpkg/tlperl/lib/Time/Piece.pm90
-rw-r--r--Master/tlpkg/tlperl/lib/Time/Seconds.pm76
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,
- '=' => \&copy;
+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,
+ '=' => \&copy;
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