"Fossies" - the Fresh Open Source Software Archive

Member "install-tl-20200916/tlpkg/tlperl/lib/Time/Local.pm" (7 Mar 2020, 14362 Bytes) of package /windows/misc/install-tl.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 package Time::Local;
    2 
    3 use strict;
    4 
    5 use Carp ();
    6 use Exporter;
    7 
    8 our $VERSION = '1.28';
    9 
   10 use parent 'Exporter';
   11 
   12 our @EXPORT = qw( timegm timelocal );
   13 our @EXPORT_OK
   14     = qw( timegm_modern timelocal_modern timegm_nocheck timelocal_nocheck );
   15 
   16 my @MonthDays = ( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 );
   17 
   18 # Determine breakpoint for rolling century
   19 my $ThisYear    = ( localtime() )[5];
   20 my $Breakpoint  = ( $ThisYear + 50 ) % 100;
   21 my $NextCentury = $ThisYear - $ThisYear % 100;
   22 $NextCentury += 100 if $Breakpoint < 50;
   23 my $Century = $NextCentury - 100;
   24 my $SecOff  = 0;
   25 
   26 my ( %Options, %Cheat );
   27 
   28 use constant SECS_PER_MINUTE => 60;
   29 use constant SECS_PER_HOUR   => 3600;
   30 use constant SECS_PER_DAY    => 86400;
   31 
   32 my $MaxDay;
   33 if ( $] < 5.012000 ) {
   34     require Config;
   35     ## no critic (Variables::ProhibitPackageVars)
   36 
   37     my $MaxInt;
   38     if ( $^O eq 'MacOS' ) {
   39 
   40         # time_t is unsigned...
   41         $MaxInt = ( 1 << ( 8 * $Config::Config{ivsize} ) )
   42             - 1;    ## no critic qw(ProhibitPackageVars)
   43     }
   44     else {
   45         $MaxInt
   46             = ( ( 1 << ( 8 * $Config::Config{ivsize} - 2 ) ) - 1 ) * 2
   47             + 1;    ## no critic qw(ProhibitPackageVars)
   48     }
   49 
   50     $MaxDay = int( ( $MaxInt - ( SECS_PER_DAY / 2 ) ) / SECS_PER_DAY ) - 1;
   51 }
   52 else {
   53     # recent localtime()'s limit is the year 2**31
   54     $MaxDay = 365 * ( 2**31 );
   55 }
   56 
   57 # Determine the EPOC day for this machine
   58 my $Epoc = 0;
   59 if ( $^O eq 'vos' ) {
   60 
   61     # work around posix-977 -- VOS doesn't handle dates in the range
   62     # 1970-1980.
   63     $Epoc = _daygm( 0, 0, 0, 1, 0, 70, 4, 0 );
   64 }
   65 elsif ( $^O eq 'MacOS' ) {
   66     $MaxDay *= 2;    # time_t unsigned ... quick hack?
   67                      # MacOS time() is seconds since 1 Jan 1904, localtime
   68                      # so we need to calculate an offset to apply later
   69     $Epoc   = 693901;
   70     $SecOff = timelocal( localtime(0) ) - timelocal( gmtime(0) );
   71     $Epoc += _daygm( gmtime(0) );
   72 }
   73 else {
   74     $Epoc = _daygm( gmtime(0) );
   75 }
   76 
   77 %Cheat = ();         # clear the cache as epoc has changed
   78 
   79 sub _daygm {
   80 
   81     # This is written in such a byzantine way in order to avoid
   82     # lexical variables and sub calls, for speed
   83     return $_[3] + (
   84         $Cheat{ pack( 'ss', @_[ 4, 5 ] ) } ||= do {
   85             my $month = ( $_[4] + 10 ) % 12;
   86             my $year  = $_[5] + 1900 - int( $month / 10 );
   87 
   88             ( ( 365 * $year )
   89                 + int( $year / 4 )
   90                     - int( $year / 100 )
   91                     + int( $year / 400 )
   92                     + int( ( ( $month * 306 ) + 5 ) / 10 ) ) - $Epoc;
   93             }
   94     );
   95 }
   96 
   97 sub _timegm {
   98     my $sec
   99         = $SecOff + $_[0]
  100         + ( SECS_PER_MINUTE * $_[1] )
  101         + ( SECS_PER_HOUR * $_[2] );
  102 
  103     return $sec + ( SECS_PER_DAY * &_daygm );
  104 }
  105 
  106 sub timegm {
  107     my ( $sec, $min, $hour, $mday, $month, $year ) = @_;
  108 
  109     if ( $Options{no_year_munging} ) {
  110         $year -= 1900;
  111     }
  112     else {
  113         if ( $year >= 1000 ) {
  114             $year -= 1900;
  115         }
  116         elsif ( $year < 100 and $year >= 0 ) {
  117             $year += ( $year > $Breakpoint ) ? $Century : $NextCentury;
  118         }
  119     }
  120 
  121     unless ( $Options{no_range_check} ) {
  122         Carp::croak("Month '$month' out of range 0..11")
  123             if $month > 11
  124             or $month < 0;
  125 
  126         my $md = $MonthDays[$month];
  127         ++$md
  128             if $month == 1 && _is_leap_year( $year + 1900 );
  129 
  130         Carp::croak("Day '$mday' out of range 1..$md")
  131             if $mday > $md or $mday < 1;
  132         Carp::croak("Hour '$hour' out of range 0..23")
  133             if $hour > 23 or $hour < 0;
  134         Carp::croak("Minute '$min' out of range 0..59")
  135             if $min > 59 or $min < 0;
  136         Carp::croak("Second '$sec' out of range 0..59")
  137             if $sec >= 60 or $sec < 0;
  138     }
  139 
  140     my $days = _daygm( undef, undef, undef, $mday, $month, $year );
  141 
  142     unless ( $Options{no_range_check} or abs($days) < $MaxDay ) {
  143         my $msg = q{};
  144         $msg .= "Day too big - $days > $MaxDay\n" if $days > $MaxDay;
  145 
  146         $year += 1900;
  147         $msg
  148             .= "Cannot handle date ($sec, $min, $hour, $mday, $month, $year)";
  149 
  150         Carp::croak($msg);
  151     }
  152 
  153     return
  154           $sec + $SecOff
  155         + ( SECS_PER_MINUTE * $min )
  156         + ( SECS_PER_HOUR * $hour )
  157         + ( SECS_PER_DAY * $days );
  158 }
  159 
  160 sub _is_leap_year {
  161     return 0 if $_[0] % 4;
  162     return 1 if $_[0] % 100;
  163     return 0 if $_[0] % 400;
  164 
  165     return 1;
  166 }
  167 
  168 sub timegm_nocheck {
  169     local $Options{no_range_check} = 1;
  170     return &timegm;
  171 }
  172 
  173 sub timegm_modern {
  174     local $Options{no_year_munging} = 1;
  175     return &timegm;
  176 }
  177 
  178 sub timelocal {
  179     my $ref_t         = &timegm;
  180     my $loc_for_ref_t = _timegm( localtime($ref_t) );
  181 
  182     my $zone_off = $loc_for_ref_t - $ref_t
  183         or return $loc_for_ref_t;
  184 
  185     # Adjust for timezone
  186     my $loc_t = $ref_t - $zone_off;
  187 
  188     # Are we close to a DST change or are we done
  189     my $dst_off = $ref_t - _timegm( localtime($loc_t) );
  190 
  191     # If this evaluates to true, it means that the value in $loc_t is
  192     # the _second_ hour after a DST change where the local time moves
  193     # backward.
  194     if (
  195         !$dst_off
  196         && ( ( $ref_t - SECS_PER_HOUR )
  197             - _timegm( localtime( $loc_t - SECS_PER_HOUR ) ) < 0 )
  198     ) {
  199         return $loc_t - SECS_PER_HOUR;
  200     }
  201 
  202     # Adjust for DST change
  203     $loc_t += $dst_off;
  204 
  205     return $loc_t if $dst_off > 0;
  206 
  207     # If the original date was a non-extent gap in a forward DST jump,
  208     # we should now have the wrong answer - undo the DST adjustment
  209     my ( $s, $m, $h ) = localtime($loc_t);
  210     $loc_t -= $dst_off if $s != $_[0] || $m != $_[1] || $h != $_[2];
  211 
  212     return $loc_t;
  213 }
  214 
  215 sub timelocal_nocheck {
  216     local $Options{no_range_check} = 1;
  217     return &timelocal;
  218 }
  219 
  220 sub timelocal_modern {
  221     local $Options{no_year_munging} = 1;
  222     return &timelocal;
  223 }
  224 
  225 1;
  226 
  227 # ABSTRACT: Efficiently compute time from local and GMT time
  228 
  229 __END__
  230 
  231 =pod
  232 
  233 =encoding UTF-8
  234 
  235 =head1 NAME
  236 
  237 Time::Local - Efficiently compute time from local and GMT time
  238 
  239 =head1 VERSION
  240 
  241 version 1.28
  242 
  243 =head1 SYNOPSIS
  244 
  245     use Time::Local;
  246 
  247     my $time = timelocal( $sec, $min, $hour, $mday, $mon, $year );
  248     my $time = timegm( $sec, $min, $hour, $mday, $mon, $year );
  249 
  250 =head1 DESCRIPTION
  251 
  252 This module provides functions that are the inverse of built-in perl functions
  253 C<localtime()> and C<gmtime()>. They accept a date as a six-element array, and
  254 return the corresponding C<time(2)> value in seconds since the system epoch
  255 (Midnight, January 1, 1970 GMT on Unix, for example). This value can be
  256 positive or negative, though POSIX only requires support for positive values,
  257 so dates before the system's epoch may not work on all operating systems.
  258 
  259 It is worth drawing particular attention to the expected ranges for the values
  260 provided. The value for the day of the month is the actual day (i.e. 1..31),
  261 while the month is the number of months since January (0..11). This is
  262 consistent with the values returned from C<localtime()> and C<gmtime()>.
  263 
  264 =head1 FUNCTIONS
  265 
  266 =head2 C<timelocal_modern()> and C<timegm_modern()>
  267 
  268 When C<Time::Local> was first written, it was a common practice to represent
  269 years as a two-digit value like C<99> for C<1999> or C<1> for C<2001>. This
  270 caused all sorts of problems (google "Y2K problem" if you're very young) and
  271 developers eventually realized that this was a terrible idea.
  272 
  273 The default exports of C<timelocal()> and C<timegm()> do a complicated
  274 calculation when given a year value less than 1000. This leads to surprising
  275 results in many cases. See L</Year Value Interpretation> for details.
  276 
  277 The C<time*_modern()> subs do not do this year munging and simply take the
  278 year value as provided.
  279 
  280 While it would be nice to make this the default behavior, that would almost
  281 certainly break a lot of code, so you must explicitly import these subs and
  282 use them instead of the default C<timelocal()> and C<timegm()>.
  283 
  284 You are B<strongly> encouraged to use these subs in any new code which uses
  285 this module. It will almost certainly make your code's behavior less
  286 surprising.
  287 
  288 =head2 C<timelocal()> and C<timegm()>
  289 
  290 This module exports two functions by default, C<timelocal()> and C<timegm()>.
  291 
  292 The C<timelocal()> and C<timegm()> functions perform range checking on the
  293 input $sec, $min, $hour, $mday, and $mon values by default.
  294 
  295 =head2 C<timelocal_nocheck()> and C<timegm_nocheck()>
  296 
  297 If you are working with data you know to be valid, you can speed your code up
  298 by using the "nocheck" variants, C<timelocal_nocheck()> and
  299 C<timegm_nocheck()>. These variants must be explicitly imported.
  300 
  301     use Time::Local 'timelocal_nocheck';
  302 
  303     # The 365th day of 1999
  304     print scalar localtime timelocal_nocheck( 0, 0, 0, 365, 0, 99 );
  305 
  306 If you supply data which is not valid (month 27, second 1,000) the results
  307 will be unpredictable (so don't do that).
  308 
  309 =head2 Year Value Interpretation
  310 
  311 B<This does not apply to C<timelocal_modern> or C<timegm_modern>. Use those
  312 exports if you want to ensure consistent behavior as your code ages.>
  313 
  314 Strictly speaking, the year should be specified in a form consistent with
  315 C<localtime()>, i.e. the offset from 1900. In order to make the interpretation
  316 of the year easier for humans, however, who are more accustomed to seeing
  317 years as two-digit or four-digit values, the following conventions are
  318 followed:
  319 
  320 =over 4
  321 
  322 =item *
  323 
  324 Years greater than 999 are interpreted as being the actual year, rather than
  325 the offset from 1900. Thus, 1964 would indicate the year Martin Luther King
  326 won the Nobel prize, not the year 3864.
  327 
  328 =item *
  329 
  330 Years in the range 100..999 are interpreted as offset from 1900, so that 112
  331 indicates 2012. This rule also applies to years less than zero (but see note
  332 below regarding date range).
  333 
  334 =item *
  335 
  336 Years in the range 0..99 are interpreted as shorthand for years in the rolling
  337 "current century," defined as 50 years on either side of the current
  338 year. Thus, today, in 1999, 0 would refer to 2000, and 45 to 2045, but 55
  339 would refer to 1955. Twenty years from now, 55 would instead refer to
  340 2055. This is messy, but matches the way people currently think about two
  341 digit dates. Whenever possible, use an absolute four digit year instead.
  342 
  343 =back
  344 
  345 The scheme above allows interpretation of a wide range of dates, particularly
  346 if 4-digit years are used.
  347 
  348 =head2 Limits of time_t
  349 
  350 On perl versions older than 5.12.0, the range of dates that can be actually be
  351 handled depends on the size of C<time_t> (usually a signed integer) on the
  352 given platform. Currently, this is 32 bits for most systems, yielding an
  353 approximate range from Dec 1901 to Jan 2038.
  354 
  355 Both C<timelocal()> and C<timegm()> croak if given dates outside the supported
  356 range.
  357 
  358 As of version 5.12.0, perl has stopped using the time implementation of the
  359 operating system it's running on. Instead, it has its own implementation of
  360 those routines with a safe range of at least +/- 2**52 (about 142 million
  361 years)
  362 
  363 =head2 Ambiguous Local Times (DST)
  364 
  365 Because of DST changes, there are many time zones where the same local time
  366 occurs for two different GMT times on the same day. For example, in the
  367 "Europe/Paris" time zone, the local time of 2001-10-28 02:30:00 can represent
  368 either 2001-10-28 00:30:00 GMT, B<or> 2001-10-28 01:30:00 GMT.
  369 
  370 When given an ambiguous local time, the timelocal() function should always
  371 return the epoch for the I<earlier> of the two possible GMT times.
  372 
  373 =head2 Non-Existent Local Times (DST)
  374 
  375 When a DST change causes a locale clock to skip one hour forward, there will
  376 be an hour's worth of local times that don't exist. Again, for the
  377 "Europe/Paris" time zone, the local clock jumped from 2001-03-25 01:59:59 to
  378 2001-03-25 03:00:00.
  379 
  380 If the C<timelocal()> function is given a non-existent local time, it will
  381 simply return an epoch value for the time one hour later.
  382 
  383 =head2 Negative Epoch Values
  384 
  385 On perl version 5.12.0 and newer, negative epoch values are fully supported.
  386 
  387 On older versions of perl, negative epoch (C<time_t>) values, which are not
  388 officially supported by the POSIX standards, are known not to work on some
  389 systems. These include MacOS (pre-OSX) and Win32.
  390 
  391 On systems which do support negative epoch values, this module should be able
  392 to cope with dates before the start of the epoch, down the minimum value of
  393 time_t for the system.
  394 
  395 =head1 IMPLEMENTATION
  396 
  397 These routines are quite efficient and yet are always guaranteed to agree with
  398 C<localtime()> and C<gmtime()>. We manage this by caching the start times of
  399 any months we've seen before. If we know the start time of the month, we can
  400 always calculate any time within the month.  The start times are calculated
  401 using a mathematical formula. Unlike other algorithms that do multiple calls
  402 to C<gmtime()>.
  403 
  404 The C<timelocal()> function is implemented using the same cache. We just
  405 assume that we're translating a GMT time, and then fudge it when we're done
  406 for the timezone and daylight savings arguments. Note that the timezone is
  407 evaluated for each date because countries occasionally change their official
  408 timezones. Assuming that C<localtime()> corrects for these changes, this
  409 routine will also be correct.
  410 
  411 =head1 AUTHORS EMERITUS
  412 
  413 This module is based on a Perl 4 library, timelocal.pl, that was
  414 included with Perl 4.036, and was most likely written by Tom
  415 Christiansen.
  416 
  417 The current version was written by Graham Barr.
  418 
  419 =head1 BUGS
  420 
  421 The whole scheme for interpreting two-digit years can be considered a bug.
  422 
  423 Bugs may be submitted at L<https://github.com/houseabsolute/Time-Local/issues>.
  424 
  425 There is a mailing list available for users of this distribution,
  426 L<mailto:datetime@perl.org>.
  427 
  428 I am also usually active on IRC as 'autarch' on C<irc://irc.perl.org>.
  429 
  430 =head1 SOURCE
  431 
  432 The source code repository for Time-Local can be found at L<https://github.com/houseabsolute/Time-Local>.
  433 
  434 =head1 AUTHOR
  435 
  436 Dave Rolsky <autarch@urth.org>
  437 
  438 =head1 CONTRIBUTORS
  439 
  440 =for stopwords Florian Ragwitz J. Nick Koston Unknown
  441 
  442 =over 4
  443 
  444 =item *
  445 
  446 Florian Ragwitz <rafl@debian.org>
  447 
  448 =item *
  449 
  450 J. Nick Koston <nick@cpanel.net>
  451 
  452 =item *
  453 
  454 Unknown <unknown@example.com>
  455 
  456 =back
  457 
  458 =head1 COPYRIGHT AND LICENSE
  459 
  460 This software is copyright (c) 1997 - 2018 by Graham Barr & Dave Rolsky.
  461 
  462 This is free software; you can redistribute it and/or modify it under
  463 the same terms as the Perl 5 programming language system itself.
  464 
  465 The full text of the license can be found in the
  466 F<LICENSE> file included with this distribution.
  467 
  468 =cut