diff options
author | Karl Berry <karl@freefriends.org> | 2019-03-10 21:56:14 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2019-03-10 21:56:14 +0000 |
commit | e0a2a718e89f9700d627f1e6a8eea8f21d2fbeb8 (patch) | |
tree | 39972f65008b0d70f306a5f976494d29411bc41e /Master/tlpkg/tlperl/lib/Time | |
parent | b206fdc77d81ed1600949062f08de5690a4bf66f (diff) |
tl19 perl 5.28.1 for Windows, from Siep
git-svn-id: svn://tug.org/texlive/trunk@50322 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Time')
-rw-r--r-- | Master/tlpkg/tlperl/lib/Time/HiRes.pm | 60 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/Time/Piece.pm | 330 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/Time/Seconds.pm | 23 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/Time/gmtime.pm | 10 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/Time/localtime.pm | 11 |
5 files changed, 375 insertions, 59 deletions
diff --git a/Master/tlpkg/tlperl/lib/Time/HiRes.pm b/Master/tlpkg/tlperl/lib/Time/HiRes.pm index a3ddd595b74..59f0f3aad98 100644 --- a/Master/tlpkg/tlperl/lib/Time/HiRes.pm +++ b/Master/tlpkg/tlperl/lib/Time/HiRes.pm @@ -4,31 +4,53 @@ package Time::HiRes; use strict; require Exporter; -require DynaLoader; +use XSLoader (); -our @ISA = qw(Exporter DynaLoader); +our @ISA = qw(Exporter); our @EXPORT = qw( ); +# More or less this same list is in Makefile.PL. Should unify. our @EXPORT_OK = qw (usleep sleep ualarm alarm gettimeofday time tv_interval getitimer setitimer nanosleep clock_gettime clock_getres clock clock_nanosleep - CLOCK_BOOTTIME CLOCK_HIGHRES - CLOCK_MONOTONIC CLOCK_MONOTONIC_COARSE - CLOCK_MONOTONIC_PRECISE CLOCK_MONOTONIC_RAW + CLOCKS_PER_SEC + CLOCK_BOOTTIME + CLOCK_HIGHRES + CLOCK_MONOTONIC + CLOCK_MONOTONIC_COARSE + CLOCK_MONOTONIC_FAST + 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 + CLOCK_PROF + CLOCK_REALTIME + CLOCK_REALTIME_COARSE + CLOCK_REALTIME_FAST + CLOCK_REALTIME_PRECISE + CLOCK_REALTIME_RAW + CLOCK_SECOND + CLOCK_SOFTTIME + CLOCK_THREAD_CPUTIME_ID + CLOCK_TIMEOFDAY + CLOCK_UPTIME + CLOCK_UPTIME_COARSE + CLOCK_UPTIME_FAST + CLOCK_UPTIME_PRECISE + CLOCK_UPTIME_RAW + CLOCK_VIRTUAL + ITIMER_PROF + ITIMER_REAL + ITIMER_REALPROF + ITIMER_VIRTUAL TIMER_ABSTIME d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer - d_nanosleep d_clock_gettime d_clock_getres d_hires_utime - d_clock d_clock_nanosleep + d_nanosleep d_clock_gettime d_clock_getres + d_clock d_clock_nanosleep d_hires_stat + d_futimens d_utimensat d_hires_utime stat lstat utime ); -our $VERSION = '1.9741'; +our $VERSION = '1.9759'; our $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -69,7 +91,7 @@ sub import { Time::HiRes->export_to_level(1, $this, @_); } -bootstrap Time::HiRes; +XSLoader::load( 'Time::HiRes', $XS_VERSION ); # Preloaded methods go here. @@ -454,8 +476,10 @@ time stamp from t1: it may be equal or I<less>. As L<perlfunc/utime> but with the ability to set the access/modify file timestamps -in subsecond resolution, if the operating system and the filesystem -both support such timestamps. To override the standard utime(): +in subsecond resolution, if the operating system and the filesystem, +and the mount options of the filesystem, all support such timestamps. + +To override the standard utime(): use Time::HiRes qw(utime); @@ -468,6 +492,10 @@ call the syscall with a NULL argument. The actual achievable subsecond resolution depends on the combination of the operating system and the filesystem. +Modifying the timestamps may not be possible at all: for example, the +C<noatime> filesystem mount option may prohibit you from changing the +access time timestamp. + Returns the number of files successfully changed. =back diff --git a/Master/tlpkg/tlperl/lib/Time/Piece.pm b/Master/tlpkg/tlperl/lib/Time/Piece.pm index 6dbf4d69c44..8acba86e76c 100644 --- a/Master/tlpkg/tlperl/lib/Time/Piece.pm +++ b/Master/tlpkg/tlperl/lib/Time/Piece.pm @@ -2,13 +2,11 @@ package Time::Piece; use strict; -require DynaLoader; +use XSLoader (); use Time::Seconds; use Carp; use Time::Local; -our @ISA = qw(DynaLoader); - use Exporter (); our @EXPORT = qw( @@ -20,9 +18,9 @@ our %EXPORT_TAGS = ( ':override' => 'internal', ); -our $VERSION = '1.31'; +our $VERSION = '1.3204'; -bootstrap Time::Piece $VERSION; +XSLoader::load( 'Time::Piece', $VERSION ); my $DATE_SEP = '-'; my $TIME_SEP = ':'; @@ -31,6 +29,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, @@ -68,7 +69,10 @@ sub new { my $self; - if (defined($time)) { + if (ref($time)) { + $self = $time->[c_islocal] ? $class->localtime($time) : $class->gmtime($time); + } + elsif (defined($time)) { $self = $class->localtime($time); } elsif (ref($class) && $class->isa(__PACKAGE__)) { @@ -96,19 +100,21 @@ 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; if (ref($time)) { - my @tm_parts = (@{$time}[c_sec .. c_mon], $time->[c_year]+1900); - $time->[c_epoch] = $islocal ? timelocal(@tm_parts) : timegm(@tm_parts); + my @new_time = @$time; + my @tm_parts = (@new_time[c_sec .. c_mon], $new_time[c_year]+1900); + $new_time[c_epoch] = $islocal ? timelocal(@tm_parts) : timegm(@tm_parts); - return wantarray ? @$time : bless [@$time[0..9], $islocal], $class; + return wantarray ? @new_time : bless [@new_time[0..9], $islocal], $class; } _tzset(); my @time = $islocal ? @@ -456,31 +462,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 +590,7 @@ sub day_list { my @old = @DAY_LIST; if (@_) { @DAY_LIST = @_; + &Time::Piece::_default_locale(); } return @old; } @@ -497,6 +600,7 @@ sub mon_list { my @old = @MON_LIST; if (@_) { @MON_LIST = @_; + &Time::Piece::_default_locale(); } return @old; } @@ -634,6 +738,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 +888,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 +969,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 +988,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 +1017,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 +1028,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 +1063,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 +1158,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/Master/tlpkg/tlperl/lib/Time/Seconds.pm b/Master/tlpkg/tlperl/lib/Time/Seconds.pm index 965e3a6e502..3a56b74485f 100644 --- a/Master/tlpkg/tlperl/lib/Time/Seconds.pm +++ b/Master/tlpkg/tlperl/lib/Time/Seconds.pm @@ -1,7 +1,7 @@ package Time::Seconds; use strict; -our $VERSION = '1.31'; +our $VERSION = '1.3204'; 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/Master/tlpkg/tlperl/lib/Time/gmtime.pm b/Master/tlpkg/tlperl/lib/Time/gmtime.pm index eb5b371a004..99f470be51f 100644 --- a/Master/tlpkg/tlperl/lib/Time/gmtime.pm +++ b/Master/tlpkg/tlperl/lib/Time/gmtime.pm @@ -4,7 +4,12 @@ use 5.006_001; use Time::tm; -our(@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION); +our (@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION); +our ( $tm_sec, $tm_min, $tm_hour, $tm_mday, + $tm_mon, $tm_year, $tm_wday, $tm_yday, + $tm_isdst, +); + BEGIN { use Exporter (); @ISA = qw(Exporter Time::tm); @@ -15,9 +20,8 @@ BEGIN { $tm_isdst ); %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] ); - $VERSION = 1.03; + $VERSION = 1.04; } -use vars @EXPORT_OK; sub populate (@) { return unless @_; diff --git a/Master/tlpkg/tlperl/lib/Time/localtime.pm b/Master/tlpkg/tlperl/lib/Time/localtime.pm index c3d9fb36085..f2ef0840383 100644 --- a/Master/tlpkg/tlperl/lib/Time/localtime.pm +++ b/Master/tlpkg/tlperl/lib/Time/localtime.pm @@ -4,7 +4,13 @@ use 5.006_001; use Time::tm; -our(@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION); +our (@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION); +our ( + $tm_sec, $tm_min, $tm_hour, $tm_mday, + $tm_mon, $tm_year, $tm_wday, $tm_yday, + $tm_isdst +); + BEGIN { use Exporter (); @ISA = qw(Exporter Time::tm); @@ -15,9 +21,8 @@ BEGIN { $tm_isdst ); %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] ); - $VERSION = 1.02; + $VERSION = 1.03; } -use vars @EXPORT_OK; sub populate (@) { return unless @_; |