Astro-satpass
view release on metacpan or search on metacpan
lib/Astro/Coord/ECI/TLE.pm view on Meta::CPAN
originator => 0,
pass_threshold => sub {
my ($self, $name, $value) = @_;
not defined $value
or looks_like_number( $value )
or carp "Invalid $name '$value'";
$self->{$name} = $value;
return 0;
},
reblessable => sub {
my $doit = !$_[0]{$_[1]} && $_[2] && $_[0]->get ('id');
$_[0]{$_[1]} = $_[2];
$doit and $_[0]->rebless ();
return 0;
},
intrinsic_magnitude => \&_set_optional_float_no_reinit,
);
my %static = (
appulse => deg2rad (10), # Report appulses < 10 degrees.
backdate => 1, # Use object in pass before its epoch.
geometric => 0, # Use geometric horizon for pass rise/set.
gravconst_r => 72, # Specify geodetic data set for sgp4r.
illum => 'sun',
interval => 0,
lazy_pass_position => 0,
model => 'model',
pass_variant => 0,
reblessable => 1,
visible => 1,
);
my %model_attrib = ( # For the benefit of is_model_attribute()
ds50 => 1, # Read-only, but it fits the definition.
epoch => 1, # Hand-set, since we dont want to call the code.
epoch_dynamical => 1, # Read-only, but fits the definition.
);
foreach (keys %attrib) {
$model_attrib{$_} = 1 if $attrib{$_} && !ref $attrib{$_}
}
my %status; # Subclassing data - initialized at end
my %magnitude_table; # Magnitude data - initialized at end
my $magnitude_adjust = 0; # Adjustment to magnitude table value
use constant TLE_INIT => '_init';
=item $tle = Astro::Coord::ECI::TLE->new()
This method instantiates an object to represent a NORAD two- or
three-line orbital element set. This is a subclass of
L<Astro::Coord::ECI|Astro::Coord::ECI>.
Any arguments get passed to the set() method.
It is both anticipated and recommended that you use the parse()
method instead of this method to create an object, since the models
currently have no code to guard against incomplete data.
=cut
sub new {
my $class = shift;
my $self = $class->SUPER::new (%static, @_);
return $self;
}
=item $tle->after_reblessing (\%possible_attributes)
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 it does nothing.
=cut
sub after_reblessing {}
=item Astro::Coord::ECI::TLE->alias (name => class ...)
This static method adds an alias for a class name, for the benefit of
users of the status() method and 'illum' attributes, and ultimately of
the rebless() method. It is intended to be used by subclasses to
register short names for themselves upon initialization, though of
course you can call it yourself as well.
For example, this class calls
__PACKAGE__->alias (tle => __PACKAGE__);
You can register more than one alias in a single call. Aliases
can be deleted by assigning them a false value (e.g. '' or undef).
If called without arguments, it returns the current aliases.
You can actually call this as a normal method, but it still behaves
like a static method.
=cut
my %type_map = ();
sub alias {
my ($self, @args) = @_;
@args % 2 and croak <<eod;
Error - Must have even number of arguments for alias().
eod
return wantarray ? %type_map : {%type_map} unless @args;
while (@args) {
my $name = shift @args;
my $class = shift @args or do {
delete $type_map{$name};
next;
};
$class = $type_map{$class} if $type_map{$class};
load_module ($class);
$type_map{$name} = $class;
}
return $self;
}
__PACKAGE__->alias (tle => __PACKAGE__);
=item $kilometers = $tle->apoapsis();
This method returns the apoapsis of the orbit, in kilometers. Since
Astro::Coord::ECI::TLE objects always represent bodies orbiting the
Earth, this is more usually called apogee.
Note that this is the distance from the center of the Earth, not the
altitude.
=cut
sub apoapsis {
my $self = shift;
return $self->{&TLE_INIT}{TLE_apoapsis} ||=
(1 + $self->get('eccentricity')) * $self->semimajor();
}
=item $kilometers = $tle->apogee();
This method is simply a synonym for apoapsis().
=cut
*apogee = \&apoapsis;
# See Astro::Coord::ECI for docs.
sub attribute {
return exists $attrib{$_[1]} ?
__PACKAGE__ :
$_[0]->SUPER::attribute ($_[1])
}
=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 it does nothing.
=cut
sub before_reblessing {}
=item $type = $tle->body_type ()
This method returns the type of the body as one of the BODY_TYPE_*
constants. This is the C<'object_type'> attribute if that is defined.
Otherwise it is derived from the common name using an algorithm similar
to the one used by the Space Track web site. This algorithm will not
work if the common name is not available, or if it does not conform to
the Space Track naming conventions. Known or suspected differences from
the algorithm described at the bottom of the Satellite Box Score page
include:
* The C<Astro::Coord::ECI::TLE> algorithm is not case-sensitive. The
Space Track algorithm appears to assume all upper-case.
* The C<Astro::Coord::ECI::TLE> algorithm looks for words (that is,
alphanumeric strings delimited by non-alphanumeric characters), whereas
the Space Track documentation seems to say it just looks for substrings.
However, implementing the documented algorithm literally results in OID
20479 'DEBUT (ORIZURU)' being classified as debris, whereas Space Track
returns it in response to a query for name 'deb' that excludes debris.
The possible returns are:
C<< BODY_TYPE_UNKNOWN => dualvar( 0, 'unknown' ) >> if the value of the
C<name> attribute is C<undef>, or if it is empty or contains only
white space.
C<< BODY_TYPE_DEBRIS => dualvar( 1, 'debris' ) >> if the value of the
C<name> attribute contains one of the words 'deb', 'debris', 'coolant',
'shroud', or 'westford needles', all checks being case-insensitive.
C<< BODY_TYPE_ROCKET_BODY => dualvar( 2, 'rocket body' ) >> if the body
is not debris, but the value of the C<name> attribute contains one of
the strings 'r/b', 'akm' (for 'apogee kick motor') or 'pkm' (for
'perigee kick motor') all checks being case-insensitive.
C<< BODY_TYPE_PAYLOAD => dualvar( 3, 'payload' ) >> if the body is not
unknown, debris, or a rocket body.
The above constants are not exported by default, but they are exportable
either by name or using the C<:constants> tag.
If L<Scalar::Util|Scalar::Util> does not export C<dualvar()>, the
constants are defined to be numeric. The cautious programmer will
therefore test them using numeric tests.
lib/Astro/Coord/ECI/TLE.pm view on Meta::CPAN
C<azel_offset()> documentation for whether this class'
C<correct_for_refraction()> method is actually called by those methods.
=cut
sub correct_for_refraction {
my ( undef, $elevation ) = @_; # Invocant unused
return $elevation;
}
=item $value = $tle->ds50($time)
This method converts the time to days since 1950 Jan 0, 0 h GMT.
The time defaults to the epoch of the data set. This method does not
affect the $tle object - it is exposed for convenience and for testing
purposes.
It can also be called as a "static" method, i.e. as
Astro::Coord::ECI::TLE->ds50 ($time), but in this case the time may not
be defaulted, and no attempt has been made to make this a pretty error.
=cut
{ # Begin local symbol block
# Because different Perl implementations may have different
# epochs, we assume that 2000 Jan 1 0h UT is representable, and
# pre-calculate that time in terms of seconds since the epoch.
# Then, when the method is called, we convert the argument to
# days since Y2K, and then add the magic number needed to get
# us to days since 1950 Jan 0 0h UT.
my $y2k = greg_time_gm( 0, 0, 0, 1, 0, 2000 ); # Calc. time of 2000 Jan 1 0h UT
sub ds50 {
my ($self, $epoch) = @_;
defined $epoch or $epoch = $self->{epoch};
my $rslt = ($epoch - $y2k) / SECSPERDAY + 18263;
(ref $self && $self->{debug}) and print <<eod;
Debug ds50 ($epoch) = $rslt
eod
return $rslt;
}
} # End local symbol block
=item $value = $tle->get('attribute')
This method retrieves the value of the given attribute. See the
L</Attributes> section for a description of the attributes.
=cut
{
my %accessor = (
tle => sub {$_[0]{$_[1]} ||= $_[0]->_make_tle()},
);
sub get {
my $self = shift;
my $name = shift;
if (ref $self) {
exists $attrib{$name} or return $self->SUPER::get ($name);
return $accessor{$name} ?
$accessor{$name}->($self, $name) :
$self->{$name};
} else {
exists $static{$name} or
return $self->SUPER::get ($name);
return $static{$name};
}
}
}
=item $illuminated = $tle->illuminated();
This method returns a true value if the body is illuminated, and a false
value if it is not.
=cut
sub illuminated {
my ( $self, $time ) = @_;
return $self->__sun_elev_from_sat( $time ) >= 0;
}
=item @events = $tle->intrinsic_events( $start, $end );
This method returns any events that are intrinsic to the C<$tle> object.
If optional argument C<$start> is defined, only events occurring at or
after that Perl time are returned. Similarly, if optional argument
C<$end> is defined, only events occurring before that Perl time are
returned.
The return is an array of array references. Each array reference
specifies the Perl time of the event and a text description of the
event.
At this level of the object hierarchy nothing is returned. Subclasses
may override this to add C<pass()> events. The overrides should return
anything returned by C<SUPER::intrinsic_events(...)> in addition to
anything they return themselves.
The order of the returned events is undefined.
=cut
sub intrinsic_events {
return;
}
=item $deep = $tle->is_deep();
This method returns true if the object is in deep space - meaning that
its period is at least 225 minutes (= 13500 seconds).
=cut
sub is_deep {
return $_[0]->{&TLE_INIT}{TLE_isdeep}
if exists $_[0]->{&TLE_INIT}{TLE_isdeep};
return ($_[0]->{&TLE_INIT}{TLE_isdeep} = $_[0]->period () >= 13500);
}
=item $boolean = $tle->is_model_attribute ($name);
This method returns true if the named attribute is an attribute of
the model - i.e. it came from the TLE data and actually affects the
model computations. It is really for the benefit of
Astro::Coord::ECI::TLE::Set, so that class can determine how its
set() method should handle the attribute.
=cut
sub is_model_attribute { return $model_attrib{$_[1]} }
=item $boolean = $tle->is_valid_model ($model_name);
This method returns true if the given name is the name of an orbital
model, and false otherwise.
Actually, in the spirit of UNIVERSAL::can, it returns a reference to
the code if the model exists, and undef otherwise.
This is really for the benefit of Astro::Coord::ECI::TLE::Set, so it
knows it needs to select the correct member object before running the
model.
This method can be called as a static method, or even as a subroutine.
=cut
{ # Begin local symbol block
my %valid = map {$_ => __PACKAGE__->can ($_)}
qw{model model4 model4r model8 null sdp4 sdp8 sgp sgp4 sgp4r sgp8};
#>>> NOTE WELL
#>>> If a model is added, the period method must change
#>>> as well, to calculate using the new model. I really
#>>> ought to do all this with code attributes.
lib/Astro/Coord/ECI/TLE.pm view on Meta::CPAN
The calculation is carried out using the period implied by the current
model.
=cut
{
my $mu = 3.986005e5; # km ** 3 / sec ** 2 -- for Earth.
sub semimajor {
my $self = shift;
return $self->{&TLE_INIT}{TLE_semimajor} ||= do {
my $to2pi = $self->period / SGP_TWOPI;
exp (log ($to2pi * $to2pi * $mu) / 3);
};
}
}
=item $kilometers = $tle->semiminor();
This method calculates the semiminor axis of the orbit, using the
semimajor axis and the eccentricity, by the equation
b = a * sqrt(1 - e)
where a is the semimajor axis and e is the eccentricity.
=cut
sub semiminor {
my $self = shift;
return $self->{&TLE_INIT}{TLE_semiminor} ||= do {
my $e = $self->get('eccentricity');
$self->semimajor() * sqrt(1 - $e * $e);
};
}
=item $tle->set (attribute => value ...)
This method sets the values of the various attributes. The changing of
attributes actually used by the orbital models will cause the models to
be reinitialized. This happens transparently, and is no big deal. For
a description of the attributes, see L</Attributes>.
Because this is a subclass of L<Astro::Coord::ECI|Astro::Coord::ECI>,
any attributes of that class can also be set.
=cut
sub set {
my ($self, @args) = @_;
@args % 2 and croak "The set method takes an even number of arguments.";
my ($clear, $extant);
if (ref $self) {
$extant = \%attrib;
} else {
$self = $extant = \%static;
}
while (@args) {
my $name = shift @args;
my $val = shift @args;
exists $extant->{$name} or do {
$self->SUPER::set ($name, $val);
next;
};
defined $attrib{$name} or croak "Attribute $name is read-only.";
if ( CODE_REF eq ref $attrib{$name} ) {
$attrib{$name}->($self, $name, $val) and $clear = 1;
} else {
$self->{$name} = $val;
$clear ||= $attrib{$name};
}
}
$clear and delete $self->{&TLE_INIT};
return $self;
}
=item Astro::Coord::ECI::TLE->status (command => arguments ...)
This method maintains the internal status table, which is used by the
parse() method to determine which subclass (if any) to bless the
created object into. The first argument determines what is done to the
status table; subsequent arguments depend on the first argument. Valid
commands and arguments are:
status (add => $id, $type => $status, $name, $comment) adds an item to
the status table or modifies an existing item. The $id is the NORAD ID
of the body.
No types are supported out of the box, but if you have installed
L<Astro::Coord::ECI::TLE::Iridium|Astro::Coord::ECI::TLE::Iridium> that
or C<'iridium'> will work.
The $status is 0, 1, 2, or 3 representing in-service, spare, failed, or
decayed respectively. The strings '+' or '' will be interpreted as 0,
'S', 's', or '?' as 1, 'D' as 3, and any other non-numeric string as 2.
The $name and $comment arguments default to empty.
status ('clear') clears the status table.
status (clear => 'type') clears all entries of the given type in the
status table. For supported types, see the discussion of 'add',
above.
status (drop => $id) removes the given NORAD ID from the status table.
status ('show') returns a list of list references, representing the
'add' commands which would be used to regenerate the status table.
Initially, the status table is populated with the status as of December
3, 2010.
=cut
sub status {
my ( undef, $cmd, @arg ) = @_; # Invocant unused
if ($cmd eq 'add') {
my ( $id, $type, $status, $name, $comment ) = @arg;
$id or croak <<eod;
Error - The status ('add') call requires a NORAD ID.
eod
$id =~ m/ [^0-9] /smx
or $id = sprintf '%05d', $id;
( run in 2.109 seconds using v1.01-cache-2.11-cpan-5511b514fd6 )