view release on metacpan or  search on metacpan

lib/Astro/Coord/ECI/Utils.pm  view on Meta::CPAN

	    $offset -= $sign . ( ( $hr * 60 + ( $min || 0 ) ) * 60 )
	}

	foreach ( @date ) {
	    defined $_ and s/ [^0-9]+ //smxg;
	}

	$date[0] = __tle_year_to_Gregorian_year( $date[0] );

	defined $date[1] and --$date[1];
	defined $date[2] or $date[2] = 1;
	my $frc = pop @date;

	foreach ( @date ) {
	    defined $_ or $_ = 0;
	}

	my $time;
	if ( @zone ) {
	    $time = greg_time_gm( reverse @date );
	} else {
	    $time = greg_time_local( reverse @date );
	}

	if ( defined $frc  && $frc ne '') {
	    my $denom = 1 . ( 0 x length $frc );
	    $time += $frc / $denom;
	}

	return $time + $offset;
    }

}

sub _pre_strftime {
    my ( $format, $epoch, $places ) = @_;
    my $seconds = POSIX::floor( $epoch );
    my $frac = $epoch - $seconds;
    $format =~ s( ( %+ ) ( [.] [0-9]* )? ( [DFrRSTV] ) )
    ( _pre_strftime_mung_fmt( $1, $2, $3, $frac, $places ) )smxge;
    return ( $format, $seconds );
};

{
    # The test of __format_epoch_time_usec() (which uses format '%F %T')
    # failed under Windows, at least undef Strawberry, returning the
    # empty string. Expanding %F fixed this, so I decided to expand all
    # the 'equivalent to' format strings I could find.

    my %mung = (
	'D'	=> 'm/%%d/%%y',
	'F'	=> 'Y-%%m-%%d',
	'r'	=> 'I:%%M:%%S%s %%p',
	'R'	=> 'H:%%M',
	'S'	=> 'S%s',
	'T'	=> 'H:%%M:%%S%s',
	'V'	=> 'e-%%b-%%Y',
    );

    sub _pre_strftime_mung_fmt {
	my ( $percent, $places, $fmt, $frac, $dflt_places ) = @_;
	length( $percent ) % 2
	    and $mung{$fmt}
	    or return "$percent$places$fmt";
	my $f = '';
	defined $places
	    or $places = $dflt_places;
	if ( defined $places ) {
	    index( $places, '.' ) == 0
		or substr $places, 0, 0, '.';
	    $places eq '.'
		and $places = '';
	    $f = sprintf "%${places}f", $frac;
	    $f =~ s/ \A 0+ //smx;
	}
	return $percent . __sprintf( $mung{$fmt}, $f );
    }
}

sub __sprintf {
    my ( $tplt, @args ) = @_;
    defined $tplt
	or return undef;	## no critic (ProhibitExplicitReturnUndef)
    no if $] gt '5.021002', qw{ warnings redundant };
    return sprintf $tplt, @args;
}

{
    my %deprecate = (
	epoch2datetime	=> {
	    level	=> 0,
	    method	=> 'core subroutine gmtime',
	},
	date2epoch	=> {
	    level	=> 0,
	    method	=> 'subroutine Time::Local::timegm_posix',
	},
    );

    sub __subroutine_deprecation {
	( my $sub = ( caller 1 )[3] ) =~ s/ .* :: //smx;
	my $info = $deprecate{$sub} or return;
	$info->{level}
	    or return;
	my $msg = "Subroutine $sub() deprecated in favor of @{[
	    $info->{method} || $sub ]}()";
	$info->{level} >= 3
	    and croak $msg;
	carp $msg;
	$info->{level} == 1
	    and $info->{level} = 0;
	return;
    }
}

=item $year = __tle_year_to_Gregorian_year( $year )

The TLE data contain the year in two-digit form. NORAD decided to deal
with Y2K by decreeing that year numbers lower than 57 (the launch of
Sputnik 1) are converted to Gregorian by adding 2000. Years numbers of
57 or greater are still converted to Gregorian by adding 1900. This
subroutine encapsulates this logic. Years of 100 or greater are returned
unmodified.

This subroutine is B<private> to this package, and can be changed or
revoked without notice.

=cut

sub __tle_year_to_Gregorian_year {
    my ( $year ) = @_;
    return $year < 57 ? $year + 2000 :
	$year < 100 ? $year + 1900 : $year;
}

1;