File Coverage

blib/lib/Time/Local.pm

Criterion	Covered	Total	%
statement	69	82	84.1
branch	32	40	80.0
condition	24	36	66.6
subroutine	18	18	100.0
pod	8	8	100.0
total	151	184	82.0

package Time::Local;

use strict;

use Carp ();
use Exporter;

our $VERSION = '1.34';

use parent 'Exporter';

our @EXPORT    = qw( timegm timelocal );
our @EXPORT_OK = qw(
    timegm_modern
    timelocal_modern
    timegm_nocheck
    timelocal_nocheck
    timegm_posix
    timelocal_posix
);

my @MonthDays = ( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 );

# Determine breakpoint for rolling century
my $ThisYear    = ( localtime() )[5];
my $Breakpoint  = ( $ThisYear + 50 ) % 100;
my $NextCentury = $ThisYear - $ThisYear % 100;
$NextCentury += 100 if $Breakpoint < 50;
my $Century = $NextCentury - 100;
my $SecOff  = 0;

my ( %Options, %Cheat );

use constant SECS_PER_MINUTE => 60;
use constant SECS_PER_HOUR   => 3600;
use constant SECS_PER_DAY    => 86400;

my $MaxDay;
if ( $] < 5.012000 ) {
    require Config;
    ## no critic (Variables::ProhibitPackageVars)

    my $MaxInt;
    if ( $^O eq 'MacOS' ) {

        # time_t is unsigned...
        $MaxInt = ( 1 << ( 8 * $Config::Config{ivsize} ) )
            - 1;    ## no critic qw(ProhibitPackageVars)
    }
    else {
        $MaxInt
            = ( ( 1 << ( 8 * $Config::Config{ivsize} - 2 ) ) - 1 ) * 2
            + 1;    ## no critic qw(ProhibitPackageVars)
    }

    $MaxDay = int( ( $MaxInt - ( SECS_PER_DAY / 2 ) ) / SECS_PER_DAY ) - 1;
}
else {
    # recent localtime()'s limit is the year 2**31
    $MaxDay = 365 * ( 2**31 );

    # On (some?) 32-bit platforms this overflows and we end up with a negative
    # $MaxDay, which totally breaks this module. This is the old calculation
    # we used from the days before Perl always had 64-bit time_t.
    if ( $MaxDay < 0 ) {
        require Config;
        ## no critic (Variables::ProhibitPackageVars)
        my $max_int
            = ( ( 1 << ( 8 * $Config::Config{intsize} - 2 ) ) - 1 ) * 2 + 1;
        $MaxDay
            = int( ( $max_int - ( SECS_PER_DAY / 2 ) ) / SECS_PER_DAY ) - 1;
    }
}

# Determine the EPOC day for this machine
my $Epoc = 0;
if ( $^O eq 'vos' ) {

    # work around posix-977 -- VOS doesn't handle dates in the range
    # 1970-1980.
    $Epoc = _daygm( 0, 0, 0, 1, 0, 70, 4, 0 );
}
elsif ( $^O eq 'MacOS' ) {
    $MaxDay *= 2;    # time_t unsigned ... quick hack?
                     # MacOS time() is seconds since 1 Jan 1904, localtime
                     # so we need to calculate an offset to apply later
    $Epoc   = 693901;
    $SecOff = timelocal( localtime(0) ) - timelocal( gmtime(0) );
    $Epoc += _daygm( gmtime(0) );
}
else {
    $Epoc = _daygm( gmtime(0) );
}

%Cheat = ();    # clear the cache as epoc has changed

sub _daygm {

    # This is written in such a byzantine way in order to avoid
    # lexical variables and sub calls, for speed
    return $_[3] + (
        $Cheat{ pack( 'ss', @_[ 4, 5 ] ) } ||= do {
            my $month = ( $_[4] + 10 ) % 12;
            my $year  = $_[5] + 1900 - int( $month / 10 );

            ( ( 365 * $year )
                + int( $year / 4 )
                    - int( $year / 100 )
                    + int( $year / 400 )
                    + int( ( ( $month * 306 ) + 5 ) / 10 ) )
                - $Epoc;
        }
    );
}

sub _timegm {
    my $sec
        = $SecOff + $_[0]
        + ( SECS_PER_MINUTE * $_[1] )
        + ( SECS_PER_HOUR * $_[2] );

    return $sec + ( SECS_PER_DAY * &_daygm );
}

sub timegm {
    my ( $sec, $min, $hour, $mday, $month, $year ) = @_;
    my $subsec = $sec - int($sec);
    $sec = int($sec);

    if ( $Options{no_year_munging} ) {
        $year -= 1900;
    }
    elsif ( !$Options{posix_year} ) {
        if ( $year >= 1000 ) {
            $year -= 1900;
        }
        elsif ( $year < 100 and $year >= 0 ) {
            $year += ( $year > $Breakpoint ) ? $Century : $NextCentury;
        }
    }

    unless ( $Options{no_range_check} ) {
        Carp::croak("Month '$month' out of range 0..11")
            if $month > 11
            or $month < 0;

        my $md = $MonthDays[$month];
        ++$md
            if $month == 1 && _is_leap_year( $year + 1900 );

        Carp::croak("Day '$mday' out of range 1..$md")
            if $mday > $md or $mday < 1;
        Carp::croak("Hour '$hour' out of range 0..23")
            if $hour > 23 or $hour < 0;
        Carp::croak("Minute '$min' out of range 0..59")
            if $min > 59 or $min < 0;
        Carp::croak("Second '$sec' out of range 0..59")
            if $sec >= 60 or $sec < 0;
    }

    my $days = _daygm( undef, undef, undef, $mday, $month, $year );

    if ( abs($days) > $MaxDay && !$Options{no_range_check} ) {
        my $msg = "Day too big - abs($days) > $MaxDay\n";

        $year += 1900;
        $msg
            .= "Cannot handle date ($sec, $min, $hour, $mday, $month, $year)";

        Carp::croak($msg);
    }

    # Adding in the $subsec value last seems to prevent floating point errors
    # from creeping in.
    return (
        (
                  $sec + $SecOff
                + ( SECS_PER_MINUTE * $min )
                + ( SECS_PER_HOUR * $hour )
                + ( SECS_PER_DAY * $days )
        ) + $subsec
    );
}

sub _is_leap_year {
    return 0 if $_[0] % 4;
    return 1 if $_[0] % 100;
    return 0 if $_[0] % 400;

    return 1;
}

sub timegm_nocheck {
    local $Options{no_range_check} = 1;
    return &timegm;
}

sub timegm_modern {
    local $Options{no_year_munging} = 1;
    return &timegm;
}

sub timegm_posix {
    local $Options{posix_year} = 1;
    return &timegm;
}

sub timelocal {
    my $sec    = shift;
    my $subsec = $sec - int($sec);
    $sec = int($sec);
    unshift @_, $sec;

    my $ref_t         = &timegm;
    my $loc_for_ref_t = _timegm( localtime($ref_t) );

    my $zone_off = $loc_for_ref_t - $ref_t
        or return $loc_for_ref_t + $subsec;

    # Adjust for timezone
    my $loc_t = $ref_t - $zone_off;

    # Are we close to a DST change or are we done
    my $dst_off = $ref_t - _timegm( localtime($loc_t) );

    # If this evaluates to true, it means that the value in $loc_t is
    # the _second_ hour after a DST change where the local time moves
    # backward.
    if (
        !$dst_off
        && ( ( $ref_t - SECS_PER_HOUR )
            - _timegm( localtime( $loc_t - SECS_PER_HOUR ) ) < 0 )
    ) {
        return ( $loc_t - SECS_PER_HOUR ) + $subsec;
    }

    # Adjust for DST change
    $loc_t += $dst_off;

    return $loc_t + $subsec if $dst_off > 0;

    # If the original date was a non-existent gap in a forward DST jump, we
    # should now have the wrong answer - undo the DST adjustment
    my ( $s, $m, $h ) = localtime($loc_t);
    $loc_t -= $dst_off if $s != $_[0] || $m != $_[1] || $h != $_[2];

    return $loc_t + $subsec;
}

sub timelocal_nocheck {
    local $Options{no_range_check} = 1;
    return &timelocal;
}

sub timelocal_modern {
    local $Options{no_year_munging} = 1;
    return &timelocal;
}

sub timelocal_posix {
    local $Options{posix_year} = 1;
    return &timelocal;
}

1;

# ABSTRACT: Efficiently compute time from local and GMT time

__END__