Astro-SpaceTrack

 view release on metacpan or  search on metacpan

lib/Astro/SpaceTrack.pm  view on Meta::CPAN

    return $src;
}

=for html <a name="celestrak"></a>

=item $resp = $st->celestrak ($name);

As of version 0.158 this version is an interface to the CelesTrak API.
The argument is the argument of a Celestrak query (see
L<https://celestrak.org/NORAD/documentation/gp-data-formats.php>). The
following options are available:

=over

=item format

 --format json

This option specifies the format of the returned data. Valid values are
C<'TLE'>, C<'3LE'>, C<'2LE'>, C<'XML'>, C<'KVN'>, C<'JSON'>, or
C<'CSV'>. See
L<https://celestrak.org/NORAD/documentation/gp-data-formats.php> for a
discussion of these. C<'JSON-PRETTY'> is not a valid format option, but
will be generated if the C<pretty> attribute is true.

The default is C<'TLE'>.

=item query

 --query name

This option specifies the type of query to be done. Valid values are

=over

=item CATNR

The argument is a NORAD catalog number (1-9 digits).

=item GROUP

The argument is the name of a named group of satellites.

=item INTDES

The argument is an international launch designator of the form yyyy-nnn,
where the C<yyyy> is the Gregorian year, and the C<nnn> is the launch
number in the year.

=item NAME

The argument is a satellite name or a portion thereof.

=item SPECIAL

The argument specifies a special data set.

=back

The default is C<'CATNR'> if the argument is numeric, C<'INTDES'> if the
argument looks like an international designator, or C<'GROUP'>
otherwise.

=back

A list of valid C<GROUP> names and brief descriptions can be obtained by
calling C<< $st->names ('celestrak') >>. If you have set the C<verbose>
attribute true (e.g. C<< $st->set (verbose => 1) >>), the content of the
error response will include this list. Note, however, that this list
does not determine what can be retrieved; if Dr. Kelso adds a data set,
it can be retrieved even if it is not on the list, and if he removes
one, being on the list won't help.

If this method succeeds, the response will contain headers

 Pragma: spacetrack-type = orbit
 Pragma: spacetrack-source = celestrak

These can be accessed by C<< $st->content_type( $resp ) >> and
C<< $st->content_source( $resp ) >> respectively.

=cut

# Called dynamically
sub _celestrak_opts {	## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
    return CELESTRAK_OPTIONS;
}

sub celestrak {
    my ($self, @args) = @_;
    delete $self->{_pragmata};

    ( my $opt, @args ) = _parse_args( CELESTRAK_OPTIONS, @args );

    my $name = shift @args;
    defined $name
	or return HTTP::Response->new(
	HTTP_PRECONDITION_FAILED,
	'No catalog name specified' );

    # $self->_deprecation_notice( celestrak => $name );
    # $self->_deprecation_notice( celestrak => "--$_" ) foreach sort keys %{ $opt };

    my $query;
    ref( $query = $self->_celestrak_validate_query(
	    delete $opt->{query}, $name,
	    CELESTRAK_VALID_QUERY, 'GROUP' ) )
	and return $query;

    my $format;
    ref( $format = $self->_celestrak_validate_format(
	    delete $opt->{format} ) )
	and return $format;

    my $uri = URI->new( 'https://celestrak.org/NORAD/elements/gp.php' );
    $uri->query_form(
	$query	=> $name,
	FORMAT	=> $format,
    );

    return $self->_get_from_net(

lib/Astro/SpaceTrack.pm  view on Meta::CPAN

This option specifies the name of an output file for the data.

=item format

 --format json

This option specifies the format of the returned data. Valid values are
C<'TLE'>, C<'3LE'>, C<'2LE'>, C<'XML'>, C<'KVN'>, C<'JSON'>, or
C<'CSV'>. See
L<https://celestrak.org/NORAD/documentation/gp-data-formats.php> for a
discussion of these. C<'JSON-PRETTY'> is not a valid format option, but
will be generated if the C<pretty> attribute is true.

The default is C<'TLE'>.

=item match

This Boolean option specifies that match data be returned rather than
TLE data, if available. This option is valid only on known catalogs that
actually have match data. If this option is asserted, C<--format> and
C<--query> are invalid.

=item query

 --query name

This option specifies the type of query to be done. Valid values are

=over

=item CATNR

The argument is a NORAD catalog number (1-9 digits).

=item FILE

The argument is the name of a standard data set.

=item INTDES

The argument is an international launch designator of the form yyyy-nnn,
where the C<yyyy> is the Gregorian year, and the C<nnn> is the launch
number in the year.

=item NAME

The argument is a satellite name or a portion thereof.

=item SOURCE

The argument specifies a data source as specified at
L<https://celestrak.org/NORAD/documentation/sup-gp-queries.php>.

=item SPECIAL

The argument specifies a special data set.

=back

The default is C<'CATNR'> if the argument is numeric, C<'INTDES'> if the
argument looks like an international designator, or C<'FILE'> otherwise.

=item rms

This Boolean option specifies that RMS data be returned rather than TLE
data, if available. This option is valid only on known catalogs that
actually have RMS data. If this option is asserted, C<--format> and
C<--query> are invalid.

=back

Valid catalog names are:

 ast      AST Space Mobile
 cpf      CPF (no match data)
 css      CSS (no match data)
 glonass  Glonass satellites
 gps      GPS satellites
 intelsat Intelsat satellites
 iridium  Iridium Next
 iss      ISS (from NASA, no match data)
 kuiper   Project Kuiper (Amazon; no match data)
 oneweb   OneWeb
 planet   Planet (no, not Mercury etc.)
 ses      SES satellites
 starlink Starlink
 telesat  Telesat

You can specify options as either command-type options (e.g.
C<< celestrak_supplemental( '-file', 'foo.dat' ) >>) or as a leading
hash reference (e.g.
C<< celestrak_supplemental( { file => 'foo.dat' }) >>). If you specify
the hash reference, option names must be specified in full, without the
leading '-', and the argument list will not be parsed for command-type
options.  If you specify command-type options, they may be abbreviated,
as long as the abbreviation is unique. Errors in either sort result in
an exception being thrown.

A list of valid catalog names and brief descriptions can be obtained by
calling C<< $st->names( 'celestrak_supplemental' ) >>. If you have set
the C<verbose> attribute true (e.g. C<< $st->set (verbose => 1) >>), the
content of the error response will include this list. Note, however,
that this list does not determine what can be retrieved; if Dr. Kelso
adds a data set, it can be retrieved even if it is not on the list, and
if he removes one, being on the list won't help.

If the C<file> option was passed, the following additional header will
be provided:

 Pragma: spacetrack-cache-hit = (either true or false)

This can be accessed by the C<cache_hit()> method. If this pragma is
true, the C<Last-Modified> header of the response will contain the
modification time of the file.

B<Note> that it is my belief that the current Celestrak API (as of
September 26 2022) does not support this kind of functionality, so
C<cache_hit()> will always return false.

For more information, see
L<https://celestrak.org/NORAD/elements/supplemental/>.

lib/Astro/SpaceTrack.pm  view on Meta::CPAN

	# Parenthesized numbers are assumed to represent tumbling
	# satellites in the in-service or spare grids.
	my %exception;
	{
	    # 23-Nov-2017 update double-parenthesized 6.
	    s< [(]+ (\d+) [)]+ >
		< $exception{$1} = _BODY_STATUS_IS_TUMBLING; $1>smxge;
	}
	s/ [(] .*? [)\n] //smxg;	# Strip parenthetical comments
	foreach ( split qr{ \n }smx ) {
	    if (m/ &lt; -+ \s+ failed \s+ (?: or \s+ retired \s+ )? -+ &gt; /smxi) {
		$fail++;
		$re = qr{ (\d+) (\w?) }smx;
	    } elsif ( s/ \A \s* ( plane \s+ \d+ ) \s* : \s* //smxi ) {
		my $plane = $1;
##		s/ \A \D+ //smx;	# Strip leading non-digits
		s/ \b [[:alpha:]] .* //smx;	# Strip trailing comments
		s/ \s+ \z //smx;		# Strip trailing whitespace
		my $inx = 0;	# First 11 functional are in service
		while (m/ $re /smxg) {
		    my $num_list = $1;
		    my $detail = $2;
		    foreach my $num ( split qr{ / }smx, $num_list ) {
			$num = $num + 0;	# Numify.
			my $id = $oid{$num} or do {
#			This is normal for decayed satellites or Iridium
#			NEXT.
#			warn "No oid for Iridium $num\n";
			    next;
			};
			my $name = "Iridium $num";
			if ($fail) {
			    my $interp = $sladen_interpret_detail{$detail}
				|| $sladen_interpret_detail{''};
			    $interp->( $rslt, $id, $name, $plane );
			} else {
			    my $status = $inx > 10 ?
				_BODY_STATUS_IS_SPARE :
				_BODY_STATUS_IS_OPERATIONAL;
			    exists $exception{$num}
				and $status = $exception{$num};
			    $rslt->{$id} = [ $id, $name,
				$status_portable{kelso_inverse}{$status},
				$plane, $status ];
			}
		    }
		} continue {
		    $inx++;
		}
	    } elsif ( m/ Notes: /smx ) {
		last;
	    } else {	# TODO this is just for debugging.
		0;
	    }
	}

	return $resp;
    }

    # FIXME in the last couple days this has started returning nothing.
    # It looks like -exclude debris excludes everything, as does
    # -exclude rocket.

    # Get Iridium status from Space Track. Unlike the other sources,
    # Space Track does not know whether satellites are in service or
    # not, but it does know about all of them, and whether or not they
    # are on orbit. So the statuses we report are unknown and decayed.
    # Note that the portable status for unknown is
    # BODY_STATUS_IS_TUMBLING. Called dynamically
    sub _iridium_status_spacetrack {	## no critic (ProhibitUnusedPrivateSubroutines)
	my ( $self, undef, $rslt ) = @_;	# $fmt arg not used

	my ( $resp, $data ) = $self->search_name( {
		tle	=> 0,
		status	=> 'all',
		include	=> [ qw{ payload } ],
		format	=> 'legacy',
	    }, 'iridium' );
	$resp->is_success()
	    or return $resp;
	foreach my $body ( @{ $data } ) {
	    # Starting in 2017, the launches were Iridium Next
	    # satellites, which do not flare.
	    $body->{LAUNCH_YEAR} < 2017
		or next;
	    my $oid = $body->{NORAD_CAT_ID};
	    $rslt->{$oid}
		and not $body->{DECAY}
		and next;
	    $rslt->{$oid} = [
		$oid,
		ucfirst lc $body->{OBJECT_NAME},
		defined $body->{DECAY} ?
		( '[D]', "Decayed $body->{DECAY}", _BODY_STATUS_IS_DECAYED ) :
		( '[?]', 'SpaceTrack', _BODY_STATUS_IS_TUMBLING )
	    ];
	}
	$resp->content( join '',
	    map { "$_->[0]\t$_->[1]\t$_->[2]\t$_->[3]\n" }
	    sort { $a->[0] <=> $b->[0] }
	    values %{ $rslt }
	);
	return $resp;
    }

}	# End of local symbol block.

=for html <a name="launch_sites"></a>

=item $resp = $st->launch_sites()

This method returns an HTTP::Response object. If the request succeeds,
the content of the object will be the known launch sites and their
abbreviations in the desired format. If the desired format is
C<'legacy'> or C<'json'> and the method is called in list context, the
second returned item will be a reference to an array containing the
parsed data.

This method takes the following options, specified either command-style
or as a hash reference.

lib/Astro/SpaceTrack.pm  view on Meta::CPAN

    ARRAY_REF eq ref $data
	or $data = [ $data ];

    @{ $data }
	or return;

    if ( $context->{data} ) {
	push @{ $context->{data} }, @{ $data };
    } else {
	$context->{data} = $data;
    }

    return $data;
}

# Accessed via __PACKAGE__->can( "accumulate_${name}_return" ) in
# _accumulator_for(), above
sub _accumulate_json_return {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ( $self, $context ) = @_;

    my $json = $context->{json} ||= $self->_get_json_object(
	pretty => $context->{opt}{pretty},
    );

    $context->{data} ||= [];	# In case we did not find anything.
    return wantarray
	? ( $json->encode( $context->{data} ), $context->{data} )
	: $json->encode( $context->{data} );
}

sub _accumulate_unknown_data {
    my ( undef, $content, $context ) = @_;	# Invocant unused
    defined $context->{data}
	and Carp::croak "Unable to accumulate $context->{format} data";
    $context->{data} = $content;
    return;
}

# Accessed via __PACKAGE__->can( "accumulate_${name}_data" ) in
# _accumulator_for(), above
sub _accumulate_tle_data {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ( undef, $content, $context ) = @_;	# Invocant unused
    $context->{data} .= $content;
    return;
}

# Accessed via __PACKAGE__->can( "accumulate_${name}_data" ) in
# _accumulator_for(), above
sub _accumulate_xml_data {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ( undef, $content, $context ) = @_;
    if ( defined $context->{data} ) {
	$context->{data} =~ s{ \s* </xml> \s* \z }{}smx;
	$content =~ s{ .* <xml> \s* }{}smx;
	$context->{data} .= $content;
    } else {
	$context->{data} = $content;
    }
    return;
}

# _check_cookie_generic looks for our session cookie. If it is found, it
# returns true if it thinks the cookie is valid, and false otherwise. If
# it is not found, it returns false.

sub _record_cookie_generic {
    my ( $self, $version ) = @_;
    defined $version
	or $version = $self->{space_track_version};
    my $interface_info = $self->{_space_track_interface}[$version];
    my $cookie_name = $interface_info->{cookie_name};
    my $domain = $interface_info->{domain_space_track};

    my ( $cookie, $expires );
    $self->_get_agent()->cookie_jar->scan( sub {
	    $self->{dump_headers} & DUMP_COOKIE
		and $self->_dump_cookie( "_record_cookie_generic:\n", @_ );
	    $_[4] eq $domain
		or return;
	    $_[3] eq SESSION_PATH
		or return;
	    $_[1] eq $cookie_name
		or return;
	    ( $cookie, $expires ) = @_[2, 8];
	    return;
	} );

    # I don't get an expiration time back from the version 2 interface.
    # But the docs say the cookie is only good for about two hours, so
    # to be on the safe side I fudge in an hour.
    $version == 2
	and not defined $expires
	and $expires = time + 3600;

    if ( defined $cookie ) {
	$interface_info->{session_cookie} = $cookie;
	$self->{dump_headers} & DUMP_TRACE
	    and warn "Session cookie: $cookie\n";	## no critic (RequireCarping)
	if ( exists $interface_info->{cookie_expires} ) {
	    $interface_info->{cookie_expires} = $expires;
	    $self->{dump_headers} & DUMP_TRACE
		and warn 'Cookie expiration: ',
		    POSIX::strftime( '%d-%b-%Y %H:%M:%S', localtime $expires ),
		    " ($expires)\n";	## no critic (RequireCarping)
	    return $expires > time;
	}
	return $interface_info->{session_cookie} ? 1 : 0;
    } else {
	$self->{dump_headers} & DUMP_TRACE
	    and warn "Session cookie not found\n";	## no critic (RequireCarping)
	return;
    }
}

sub _check_cookie_generic {
    my ( $self, $version ) = @_;
    defined $version
	or $version = $self->{space_track_version};
    my $interface_info = $self->{_space_track_interface}[$version];

    if ( exists $interface_info->{cookie_expires} ) {
	return defined $interface_info->{cookie_expires}

lib/Astro/SpaceTrack.pm  view on Meta::CPAN

	    mccants	=> 3,
	    sladen	=> _MASTER_IRIDIUM_DEPRECATION_LEVEL,
	},
	option => {
	    last5	=> 2,
	},
	mccants	=> {
	    mcnames	=> 3,
	    quicksat	=> 3,
	    vsnames	=> 3,
	},
	BODY_STATUS_IS_OPERATIONAL	=> _MASTER_IRIDIUM_DEPRECATION_LEVEL,
	BODY_STATUS_IS_SPARE	=> _MASTER_IRIDIUM_DEPRECATION_LEVEL,
	BODY_STATUS_IS_TUMBLING	=> _MASTER_IRIDIUM_DEPRECATION_LEVEL,
	BODY_STATUS_IS_DECAYED	=> _MASTER_IRIDIUM_DEPRECATION_LEVEL,
	spacetrack => {
	    navigation => _MASTER_FAVORITE_DEPRECATION_LEVEL,
	    weather => _MASTER_FAVORITE_DEPRECATION_LEVEL,
	    amateur => _MASTER_FAVORITE_DEPRECATION_LEVEL,
	    visible => _MASTER_FAVORITE_DEPRECATION_LEVEL,
	    special => _MASTER_FAVORITE_DEPRECATION_LEVEL,
	    bright_geosynchronous => _MASTER_FAVORITE_DEPRECATION_LEVEL,
	    human_spaceflight => _MASTER_FAVORITE_DEPRECATION_LEVEL,
	},
    );

    sub _deprecation_notice {
	my ( undef, $method, $argument ) = @_;	# Invocant unused
	defined $method
	    or ( $method = ( caller 1 )[3] ) =~ s/ .* :: //smx;
	my $level = $deprecate{$method}
	    or return;
	my $desc = $method;
	if ( ref $level ) {
	    defined $argument or Carp::confess( 'Bug - $argument undefined' );
	    $level = $level->{$argument}
		or return;
	    $desc = "$method $argument";
	}
	$level >= 3
	    and Carp::croak "$desc is retracted";
	warnings::enabled( 'deprecated' )
	    and Carp::carp "$desc is deprecated";
	1 == $level
	    or return;
	if ( ref $deprecate{$method} ) {
	    $deprecate{$method}{$argument} = 0;
	} else {
	    $deprecate{$method} = 0;
	}
	return;
    }

}

#	_dump_cookie is intended to be called from inside the
#	HTTP::Cookie->scan method. The first argument is prefix text
#	for the dump, and the subsequent arguments are the arguments
#	passed to the scan method.
#	It dumps the contents of the cookie to STDERR via a warn ().
#	A typical session cookie looks like this:
#	    version => 0
#	    key => 'spacetrack_session'
#	    val => whatever
#	    path => '/'
#	    domain => 'www.space-track.org'
#	    port => undef
#	    path_spec => 1
#	    secure => undef
#	    expires => undef
#	    discard => 1
#	    hash => {}
#	The response to the login, though, has an actual expiration
#	time, which we take cognisance of.

{	# begin local symbol block

    my @names = qw{version key val path domain port path_spec secure
	    expires discard hash};

    sub _dump_cookie {
	my ( $self, $prefix, @args ) = @_;
	my $json = $self->_get_json_object( pretty => 1 );
	$prefix and warn $prefix;	## no critic (RequireCarping)
	for (my $inx = 0; $inx < @names; $inx++) {
	    warn "    $names[$inx] => ", $json->encode( $args[$inx] ); ## no critic (RequireCarping)
	}
	return;
    }
}	# end local symbol block


#	__dump_response dumps the headers of the passed-in response
#	object. The hook is used for capturing responses to use when
#	mocking LWP::UserAgent, and is UNSUPPORTED, and subject to
#	change or retraction without notice.

sub __dump_response {
    my ( $self, $resp, $message ) = @_;

    if ( $self->{dump_headers} & DUMP_RESPONSE ) {
	my $content = $resp->content();
	if ( $self->{dump_headers} & DUMP_TRUNCATED
	    && 61 < length $content ) {
	    $content = substr( $content, 0, 61 ) . '...';
	}
	my @data = ( $resp->code(), $resp->message(), [], $content );
	foreach my $name ( $resp->headers()->header_field_names() ) {
	    my @val = $resp->header( $name );
	    push @{ $data[2] }, $name, @val > 1 ? \@val : $val[0];
	}
	if ( my $rqst = $resp->request() ) {
	    push @data, {
		method	=> $rqst->method(),
		uri	=> '' . $rqst->uri(),	# Force stringification
	    };
	}
	my $encoded = $self->_get_json_object( pretty => 1 )->encode(
	    \@data );
	defined $message
	    or $message = 'Response object';

lib/Astro/SpaceTrack.pm  view on Meta::CPAN

}

{
    my @usual_formats = map { $_ => 1 } qw{ xml json html csv };
    my $legacy_formats = {
	default	=> 'legacy',
	valid	=> { @usual_formats, map { $_ => 1 } qw{ legacy } },
    };
    my $tle_formats	= {
	default	=> 'legacy',
	valid	=> { @usual_formats, map { $_ => 1 } qw{ tle 3le legacy } },
    };
    my %format = (
	box_score	=> $legacy_formats,
	country_names	=> $legacy_formats,
	launch_sites	=> $legacy_formats,
	satcat		=> $legacy_formats,
	tle		=> $tle_formats,
    );

    sub _retrieval_format {
	my ( $table, $opt ) = @_;
	defined $table
	    or $table = defined $opt->{tle} ? $opt->{tle} ? 'tle' :
	'satcat' : 'tle';
	$opt->{json}
	    and defined $opt->{format}
	    and $opt->{format} ne 'json'
	    and Carp::croak 'Inconsistent retrieval format specification';
	$format{$table}
	    or Carp::confess "Bug - $table not supported";
	defined $opt->{format}
	    or $opt->{format} = $opt->{json} ? 'json' :
		$format{$table}{default};
	exists $opt->{json}
	    or $opt->{json} = 'json' eq $opt->{format};
	$format{$table}{valid}{ $opt->{format} }
	    or Carp::croak "Invalid $table retrieval format '$opt->{format}'";
	return $opt->{format} eq 'legacy' ? 'json' : $opt->{format};
    }
}

# my $sort = _validate_sort( $sort );
#
# Validate and canonicalize the value of the -sort option.
{
    my %valid = map { $_ => 1 } qw{ catnum epoch };
    sub _validate_sort {
	my ( $sort ) = @_;
	defined $sort
	    or return 'catnum';
	$sort = lc $sort;
	$valid{$sort}
	    or Carp::croak "Illegal sort '$sort'";
	return $sort;
    }
}

#	$opt = _parse_retrieve_dates ($opt);

#	This subroutine looks for keys start_epoch and end_epoch in the
#	given option hash, parses them as YYYY-MM-DD (where the letters
#	are digits and the dashes are any non-digit punctuation), and
#	replaces those keys' values with a reference to a list
#	containing the output of timegm() for the given time. If only
#	one epoch is provided, the other is defaulted to provide a
#	one-day date range. If the syntax is invalid, we croak.
#
#	The return is the same hash reference that was passed in.

sub _parse_retrieve_dates {
    my ( $opt ) = @_;

    my $found;
    foreach my $key ( qw{ end_epoch start_epoch } ) {

	next unless $opt->{$key};

	if ( $opt->{$key} =~ m/ \D /smx ) {
	    my $str = $opt->{$key};
	    $str =~ m< \A
		( \d+ ) \D+ ( \d+ ) \D+ ( \d+ )
		(?: \D+ ( \d+ ) (?: \D+ ( \d+ ) (?: \D+ ( \d+ ) )? )? )?
	    \z >smx
		or Carp::croak "Error - Illegal date '$str'";
	    my @time = ( $6, $5, $4, $3, $2, $1 );
	    foreach ( @time ) {
		defined $_
		    or $_ = 0;
	    }
	    if ( $time[5] > 1900 ) {
		$time[5] -= 1900;
	    } elsif ( $time[5] < 57 ) {
		$time[5] += 100;
	    }
	    $time[4] -= 1;
	    eval {
		$opt->{$key} = Time::Local::timegm( @time );
		1;
	    } or Carp::croak "Error - Illegal date '$str'";
	}

	$found++;
    }

    if ( $found ) {

	if ( $found == 1 ) {
	    $opt->{start_epoch} ||= $opt->{end_epoch} - 86400;
	    $opt->{end_epoch} ||= $opt->{start_epoch} + 86400;
	}

	$opt->{start_epoch} <= $opt->{end_epoch} or Carp::croak <<'EOD';
Error - End epoch must not be before start epoch.
EOD

	foreach my $key ( qw{ start_epoch end_epoch } ) {

	    my @time = reverse( ( gmtime $opt->{$key} )[ 0 .. 5 ] );
	    $time[0] += 1900;
	    $time[1] += 1;



( run in 1.934 second using v1.01-cache-2.11-cpan-39bf76dae61 )