view release on metacpan or  search on metacpan

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

	[   [$costheta * $cosphi, - $sintheta * $cosphi, $sinphi],
	    [$sintheta, $costheta, 0],
	    [- $costheta * $sinphi, $sintheta * $sinphi, $cosphi],
	];
    }
}	# End local symbol block.

#	We also pre-compute the inverse transforms, to facilitate the
#	recovery of the virtual image of the illuminating body.

my @inverse_transform_vector =
    map {scalar _invert_matrix_list (@$_)} @transform_vector;

=item $tle->after_reblessing (\%attribs);

This method supports reblessing into a subclass, with the argument
representing attributes that the subclass may wish to set. It is called
by rebless() and should not be called by the user.

At this level of the inheritance hierarchy, it sets the status of the
object from the {status} key of the given hash. If this key is absent,
the object is assumed capable of generating flares.

=cut

{
    # This seems to me to be a bit of a crock, but I can think of no
    # other way to prevent the intrinsic_magnitude from being clobbered
    # as not relevant to the class.
    my %retain = map { $_ => 1 }
	qw{ intrinsic_magnitude }, keys %mutator;

    sub after_reblessing {
	my ($self, $attrs) = @_;
	if (defined $attrs) {
	    $attrs = {%$attrs};
	} else {
	    $attrs = {};
	}
	HASH_REF eq ref $attrs or croak <<'EOD';
Error - The argument of after_reblessing(), if any, must be a hash
	reference.
EOD
	foreach my $key (keys %static) {
	    $attrs->{$key} = $static{$key} unless defined $attrs->{$key};
	}
	foreach my $key (keys %$attrs) {
	    delete $attrs->{$key} unless $retain{$key};
	}
	$self->set (%$attrs);
	return;
    }
}

#	see Astro::Coord::ECI->attribute ();

sub attribute {
    my ($self, $name) = @_;
    return exists $accessor{$name} ?
	__PACKAGE__ :
	$self->SUPER::attribute ($name);
}

=item $tle->before_reblessing ()

This method supports reblessing into a subclass. It is intended to do
any cleanup the old class needs before reblessing into the new class. It
is called by rebless(), and should not be called by the user.

At this level of the inheritance hierarchy, it removes the status
attribute.

=cut

sub before_reblessing {
    my ($self) = @_;
    delete $self->{&ATTRIBUTE_KEY};
    return;
}

=item $tle->can_flare ($spare);

This method returns true (in the Perl sense) if the object is capable
of producing flares, and false otherwise. If the optional $spare
argument is true, spares are considered capable of flaring, otherwise
not. If C<$spare> is C<'all'>, then all objects are considered capable
of flaring.

=cut

sub can_flare {
    my ( $self, $spare ) = @_;
    defined $spare
	and 'all' eq $spare
	and return 1;
    my $status = $self->get ('status');
    return !$status || $spare && $status == $self->BODY_STATUS_IS_SPARE;
}

=item @flares = $tle->flare ($sta, $start, $end);

This method returns the list of flares produced by the given Iridium
satellite at the given station between the given start time and the
given end time. This list may be empty. If called in scalar context you
get the number of flares.

All arguments are optional, with the defaults being

 $station = the 'station' attribute
 $start = time()
 $end = $start + 1 day

Each flare is represented by a reference to an anonymous hash, with
elements as follows:

 angle => Mirror angle, radians
 appulse => information about the position of the Sun
   angle => distance from Sun to flare, radians
   body => reference to the Sun object
 area => Projected MMA area, square radians
 azimuth => Azimuth of flare, radians

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

#	that represents the inverted matrix. If called in list context,
#	it returns the list itself. You can also pass the three input
#	list references as a list.

sub _invert_matrix_list {
    my @args = @_;
    confess <<'EOD' unless (grep { ARRAY_REF eq ref $_ } @args) == 3;
Programming error -- _invert_matrix_list takes as its arguments three
       list references.
EOD
    my ($a, $b, $c) = @{$args[0]};
    my ($d, $e, $f) = @{$args[1]};
    my ($g, $h, $i) = @{$args[2]};
    my $ei_fh = $e * $i - $f * $h;
    my $fg_di = $f * $g - $d * $i;
    my $dh_eg = $d * $h - $e * $g;
    my $A = $a * $ei_fh + $b * $fg_di + $c * $dh_eg;
    confess <<eod if $A == 0;
Programming error -- You are trying to invert a singular matrix. This
        should not happen since our purpose is to undo a rotation.
eod
    my @inv = (
	[$ei_fh / $A, ($c * $h - $b * $i) / $A, ($b * $f - $c * $e) / $A],
	[$fg_di / $A, ($a * $i - $c * $g) / $A, ($c * $d - $a * $f) / $A],
	[$dh_eg / $A, ($b * $g - $a * $h) / $A, ($a * $e - $b * $d) / $A],
    );
    return wantarray ? @inv : \@inv;
}

#	$a = _list_angle ($A, $B, $C)
#
#	This subroutine takes as input three list references, which are
#	assumed to define the coordinates of the vertices of a
#	triangle. The angle of the first vertex is computed (in
#	radians) by the law of cosines, and returned.

sub _list_angle {
    my $A = shift;
    my $B = shift;
    my $C = shift;

    my $a = distsq ($B, $C);
    my $b = distsq ($A, $C);
    my $c = distsq ($A, $B);

    return acos (($b + $c - $a) / sqrt (4 * $b * $c));
}

=item $value = $tle->get ($name);

This method returns the value of the given attribute. Attributes other
than 'status' are delegated to the parent.

=cut

sub get {
    my $self = shift;
    my $name = shift;

    if (!$accessor{$name}) {
	return $self->SUPER::get ($name);
    } elsif (ref $self) {
	return $accessor{$name}->($self, $name);
    } else {
	return $accessor{$name}->(\%statatr, $name);
    }
}

#	$status = _make_status ($message);

#	This subroutine returns a reference to a hash with key 'status'
#	containing the given message. In list context it returns the
#	hash itself.

sub _make_status {
    my %stat = (status => @_);
    return wantarray ? %stat : \%stat;
}

=item $mag = $tle->magnitude( $station );

This override of the superclass' method method returns the magnitude of
the body as seen from the given station at the body's currently-set
time. If no C<$station> is specified, the object's C<'station'>
attribute is used.  If that is not set, and exception is thrown.

This method calls the superclass' C<magnitude()>, and returns C<undef>
if the superclass does. Otherwise it adds to the magnitude of the body
itself the magnitude of any flare in progress, and returns the result.

=cut

sub magnitude {
    my ( $self, $sta ) = __default_station( @_ );
    defined( my $mag = $self->SUPER::magnitude( $sta ) )
	or return undef;	## no critic (ProhibitExplicitReturnUndef)
    my $time = $self->universal();
    my @flare = grep { defined }
	map { $_->{magnitude} }
	$self->reflection( $sta, $time );
    @flare
	and $mag = add_magnitudes( $mag, @flare );
    return $mag;
}

=item @data = $tle->reflection ($station, $time)

This method returns a list of references to hashes containing the same
data as returned for a flare, calculated for the given observer and time
for all Main Mission Antennae. If C<$time> is C<undef>, the current time
setting of the invocant is used. If C<$station> is C<undef> the current
C<station> attribute is used. Note the following differences from the
flare() hash:

If the hash contains a 'status' key which is true (in the Perl sense),
no reflection occurred, and the content of the key is a message saying
why not. If the 'mma' key exists in addition to the 'status' key, the
failure applies only to that MMA, and other MMAs may possibly generate a
reflection. If the 'mma' key does not exist, then the satellite is
either not illuminated or below the horizon for the given observer, and
the @data list will contain only a single entry.

Other than (maybe) 'mma', no other keys should be assumed to exist if
the 'status' key is true.

If called in scalar context, a reference to the \@data list is returned.

B<NOTE> that prior to 0.061_01 the C<$time> argument defaulted to the
current time. This behavior was undocumented, and therefore I felt free
to change it.

=cut

sub reflection {
    my ( $self, $station, $time ) = __default_station( @_ );
    my $method = "_reflection_$self->{&ATTRIBUTE_KEY}{algorithm}";
    return $self->$method( $station, $time );
}

# Called as $self->$method, above
sub _reflection_fixed {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ( $self, $station, $time ) = @_;
    defined $time
	or $time = $self->universal();
    my $debug = $self->get ('debug');
    my $illum = $self->get ('illum')->universal ($time);

#	Calculate whether satellite is above horizon.

    my (undef, $elev) = $station->universal ($time)->
	    azel_offset( $self->universal ($time), 0 );
    return scalar _make_status (
	sprintf ('Satellite %.2f degrees below horizon', rad2deg (-$elev)))
	unless $elev >= 0;

#	Calculate whether the satellite is illuminated.

    my $lit = ($self->azel ($illum->universal ($time)))[1] - $self->dip ();
    return scalar _make_status (
	sprintf ('Satellite fails to be illuminated by %.2f degrees',
	    rad2deg (-$lit)))
	unless $lit >= 0;

#	Transform the relevant coordinates into a coordinate system
#	in which the axis of the satellite is along the Z axis (with
#	the Earth in the negative Z direction) and the direction of
#	motion (and hence one of the Main Mission Antennae) is along
#	the X axis.

    my ( $illum_vector, $station_vector ) =
	$self->_flare_transform_coords_list( $illum, $station );

    my @rslt;

    foreach my $mma (0 .. 2) {

#	We calculate
#	the angle between the satellite and the reflection of the Sun,
#	as seen by the observer. We skip to the next antenna if no
#	reflection is generated.

	my $angle = _flare_calculate_angle_list(
		$mma, $illum_vector, $station_vector );
	warn <<eod if $debug;	## no critic (RequireCarping)
        MMA $mma Angle: @{[defined $angle ? rad2deg ($angle) . ' degrees' :
		'undefined']}
eod
	push @rslt, defined $angle ?
	    scalar $self->_flare_char_list ($station, $mma, $angle, $time,
		$illum_vector, $station_vector) :
	    scalar _make_status ('Geometry does not allow reflection',
		mma => $mma);
    }

    return wantarray ? @rslt : \@rslt;
}

=item $tle->set ($name => $value ...)

This method sets the value of the given attribute (or attributes).
Attributes other than 'status' are delegated to the parent.

=cut

sub set {
    my ($self, @args) = @_;
    while (@args) {
	my $name = shift @args;
	my $value  = shift @args;
	if (!$mutator{$name}) {
	    $self->SUPER::set ($name, $value);
	} elsif (ref $self) {
	    $mutator{$name}->($self, $name, $value);
	} else {
	    $mutator{$name}->(\%statatr, $name, $value);
	}
    }
    return $self;
}

# For use of -am and -pm
{
    my $date_time_available = eval {
	load_module( 'DateTime' );
	load_module( 'DateTime::TimeZone' );
	1;
    };

    sub _time_in_zone {
	my ( $self, $time ) = @_;

	defined( my $zone = $self->get( 'zone' ) )
	    or return localtime $time;

	looks_like_number( $zone )
	    and return gmtime( $zone * 3600 + $time );

	if ( $date_time_available ) {

	    my $dt = DateTime->from_epoch(
		epoch		=> $time,
		time_zone	=> $zone,
	    );

	    my @localtime = map { $dt->$_() } qw{ second minute hour day
	    month_0 year day_of_week_0 day_of_year_0 is_dst };
	    $localtime[5] -= 1900;
	    return @localtime;

	} else {

	    local $ENV{TZ} = $zone;
	    return localtime $time;

	}
    }
}

sub __parse_name {
    my ( $self, $name ) = @_;
    defined $name
	and $name =~ s/ \s* [[] ( \S ) []] \s* \z //smx
	and $self->_set_operational_status( status => $1 );
    return $self->SUPER::__parse_name( $name );
}

{
    my @encode_status;
    $encode_status[BODY_STATUS_IS_OPERATIONAL]	= '+';
    $encode_status[BODY_STATUS_IS_SPARE]	= 'S';
    $encode_status[BODY_STATUS_IS_TUMBLING]	= '-';
    $encode_status[BODY_STATUS_IS_DECAYED]	= 'D';

    sub __encode_operational_status {
##	my ( $self, $name, $status ) = @_;
	my ( $self, undef, $status ) = @_;	# Name unused
	defined $status
	    or $status = $self->get( 'status' );
	defined $encode_status[ $status ]
	    or return BODY_STATUS_IS_TUMBLING;
	return $encode_status[ $status ];
    }
}

{

    my %status_map = (
	BODY_STATUS_IS_OPERATIONAL()	=> BODY_STATUS_IS_OPERATIONAL,
	''			=> BODY_STATUS_IS_OPERATIONAL,
	'+'			=> BODY_STATUS_IS_OPERATIONAL,
	BODY_STATUS_IS_SPARE()		=> BODY_STATUS_IS_SPARE,
	'?'			=> BODY_STATUS_IS_SPARE,
	'S'			=> BODY_STATUS_IS_SPARE,
	's'			=> BODY_STATUS_IS_SPARE,
	'D'			=> BODY_STATUS_IS_DECAYED,
	'd'			=> BODY_STATUS_IS_DECAYED,
	BODY_STATUS_IS_TUMBLING()	=> BODY_STATUS_IS_TUMBLING,
	BODY_STATUS_IS_DECAYED()	=> BODY_STATUS_IS_DECAYED,
    );

    sub __decode_operational_status {
	my ( $value ) = @_;
	defined $value
	    or return BODY_STATUS_IS_OPERATIONAL;;
	defined $status_map{$value}
	    or return BODY_STATUS_IS_TUMBLING;
	return $status_map{$value};
    }
}

sub _set_operational_status {
    my ( $self, $name, $value ) = @_;
    $self->{&ATTRIBUTE_KEY}{$name} = __decode_operational_status( $value );
    return $self;
}

{
    my %json_map = (
	operational_status	=> \&__encode_operational_status,
    );

    sub TO_JSON {
	my ( $self ) = @_;
	return $self->__to_json(
	    \%json_map,
	    $self->SUPER::TO_JSON(),
	);
    }
}

# All Iridium Classic satellites.
#
# Generated by Astro::SpaceTrack
# $ tools/all_iridium_classic -iridium -indent=0
# on Mon Jun 29 12:08:42 2020 GMT
#
# The following static method is UNSUPPORTED, and exists solely for the
# benefit of xt/author/iridium_status.t. It may be modified or revoked
# at any time.
sub __iridium_status_as_of { return( qw{ 7 16 11 29 5 2020 } ) }

__PACKAGE__->status( clear => 'iridium' );
__PACKAGE__->status( add => 24792, iridium => 'D', 'Iridium 8', 'Decayed 2017-11-24' );
__PACKAGE__->status( add => 24793, iridium => '-', 'Iridium 7', 'Tumbling' );
__PACKAGE__->status( add => 24794, iridium => 'D', 'Iridium 6', 'Decayed 2017-12-23' );
__PACKAGE__->status( add => 24795, iridium => '-', 'Iridium 5', 'Tumbling' );
__PACKAGE__->status( add => 24796, iridium => '-', 'Iridium 4', 'Tumbling' );
__PACKAGE__->status( add => 24836, iridium => '-', 'Iridium 914', 'Tumbling' );
__PACKAGE__->status( add => 24837, iridium => 'D', 'Iridium 12', 'Decayed 2018-09-02' );
__PACKAGE__->status( add => 24838, iridium => 'D', 'Iridium 9', 'Decayed 2003-03-11' );
__PACKAGE__->status( add => 24839, iridium => 'D', 'Iridium 10', 'Decayed 2018-10-06' );
__PACKAGE__->status( add => 24840, iridium => 'D', 'Iridium 13', 'Decayed 2018-04-29' );
__PACKAGE__->status( add => 24841, iridium => '-', 'Iridium 16', 'Tumbling' );
__PACKAGE__->status( add => 24842, iridium => '-', 'Iridium 911', 'Tumbling' );
__PACKAGE__->status( add => 24869, iridium => 'D', 'Iridium 15', 'Decayed 2018-10-14' );
__PACKAGE__->status( add => 24870, iridium => '-', 'Iridium 17', 'Tumbling' );
__PACKAGE__->status( add => 24871, iridium => '-', 'Iridium 920', 'Tumbling' );
__PACKAGE__->status( add => 24872, iridium => 'D', 'Iridium 18', 'Decayed 2018-08-19' );
__PACKAGE__->status( add => 24873, iridium => '-', 'Iridium 921', 'Tumbling' );
__PACKAGE__->status( add => 24903, iridium => '-', 'Iridium 26', 'Tumbling' );
__PACKAGE__->status( add => 24904, iridium => 'D', 'Iridium 25', 'Decayed 2018-05-14' );
__PACKAGE__->status( add => 24905, iridium => 'D', 'Iridium 46', 'Decayed 2019-05-11' );
__PACKAGE__->status( add => 24906, iridium => 'D', 'Iridium 23', 'Decayed 2018-03-28' );
__PACKAGE__->status( add => 24907, iridium => '-', 'Iridium 22', 'Tumbling' );
__PACKAGE__->status( add => 24925, iridium => '-', 'Dummy mass 1', 'Tumbling' );
__PACKAGE__->status( add => 24926, iridium => '-', 'Dummy mass 2', 'Tumbling' );
__PACKAGE__->status( add => 24944, iridium => '-', 'Iridium 29', 'Tumbling' );
__PACKAGE__->status( add => 24945, iridium => 'D', 'Iridium 32', 'Decayed 2019-03-10' );
__PACKAGE__->status( add => 24946, iridium => '-', 'Iridium 33', 'Tumbling' );
__PACKAGE__->status( add => 24947, iridium => 'D', 'Iridium 27', 'Decayed 2002-02-01' );
__PACKAGE__->status( add => 24948, iridium => '-', 'Iridium 28', 'Tumbling' );
__PACKAGE__->status( add => 24949, iridium => 'D', 'Iridium 30', 'Decayed 2017-09-28' );
__PACKAGE__->status( add => 24950, iridium => 'D', 'Iridium 31', 'Decayed 2018-12-20' );
__PACKAGE__->status( add => 24965, iridium => 'D', 'Iridium 19', 'Decayed 2018-04-07' );
__PACKAGE__->status( add => 24966, iridium => 'D', 'Iridium 35', 'Decayed 2018-12-26' );
__PACKAGE__->status( add => 24967, iridium => '-', 'Iridium 36', 'Tumbling' );
__PACKAGE__->status( add => 24968, iridium => 'D', 'Iridium 37', 'Decayed 2018-05-26' );
__PACKAGE__->status( add => 24969, iridium => 'D', 'Iridium 34', 'Decayed 2018-01-08' );
__PACKAGE__->status( add => 25039, iridium => 'D', 'Iridium 43', 'Decayed 2018-02-11' );
__PACKAGE__->status( add => 25040, iridium => 'D', 'Iridium 41', 'Decayed 2018-07-28' );
__PACKAGE__->status( add => 25041, iridium => 'D', 'Iridium 40', 'Decayed 2018-09-23' );
__PACKAGE__->status( add => 25042, iridium => '-', 'Iridium 39', 'Tumbling' );
__PACKAGE__->status( add => 25043, iridium => '-', 'Iridium 38', 'Tumbling' );
__PACKAGE__->status( add => 25077, iridium => '-', 'Iridium 42', 'Tumbling' );
__PACKAGE__->status( add => 25078, iridium => '-', 'Iridium 44', 'Tumbling' );
__PACKAGE__->status( add => 25104, iridium => '-', 'Iridium 45', 'Tumbling' );