Astro-App-Satpass2
view release on metacpan or search on metacpan
lib/Astro/App/Satpass2.pm view on Meta::CPAN
package Astro::App::Satpass2;
use 5.008;
use strict;
use warnings;
use Astro::App::Satpass2::Locale qw{ __localize };
use Astro::App::Satpass2::Macro::Command;
use Astro::App::Satpass2::Macro::Code;
use Astro::App::Satpass2::ParseTime;
use Astro::App::Satpass2::Utils qw{
:os
:ref
__arguments __legal_options
expand_tilde find_package_pod
has_method instance load_package
my_dist_config quoter
__parse_class_and_args
};
use Astro::Coord::ECI 0.077; # This needs at least 0.049.
use Astro::Coord::ECI::Moon 0.077;
use Astro::Coord::ECI::Star 0.077;
use Astro::Coord::ECI::Sun 0.077;
use Astro::Coord::ECI::TLE 0.077 qw{:constants}; # This needs at least 0.059.
use Astro::Coord::ECI::TLE::Set 0.077;
# The following includes @CARP_NOT.
use Astro::Coord::ECI::Utils 0.112 qw{ :all }; # This needs at least 0.112.
{
local $@ = undef;
use constant HAVE_TLE_IRIDIUM => eval {
require Astro::Coord::ECI::TLE::Iridium;
Astro::Coord::ECI::TLE::Iridium->VERSION( 0.077 );
1;
} || 0;
# Unfortunately the alias code creates the alias even if the version
# is unacceptable; so we may have to just delete the Iridium aliases
unless( HAVE_TLE_IRIDIUM ) {
my %type_map = Astro::Coord::ECI::TLE->alias();
foreach my $name ( keys %type_map ) {
$type_map{$name} eq 'Astro::Coord::ECI::TLE::Iridium'
and Astro::Coord::ECI::TLE->alias( $name, undef );
}
}
}
use Attribute::Handlers;
use Clone ();
use Cwd ();
use File::Glob qw{ :glob };
use File::HomeDir;
use File::Spec;
use File::Temp;
use Getopt::Long 2.33;
use IO::File 1.14;
use IO::Handle;
use POSIX qw{ floor };
use Scalar::Util 1.26 qw{ blessed isdual openhandle };
use Text::Abbrev;
use Text::ParseWords (); # Used only for {level1} stuff.
use constant ASTRO_SPACETRACK_VERSION => 0.105;
use constant DEFAULT_STDOUT_LAYERS => ':encoding(utf-8)';
BEGIN {
eval {
load_package( 'Time::y2038' )
and Time::y2038->import();
lib/Astro/App/Satpass2.pm view on Meta::CPAN
$mac_cmd{$_} = $_;
}
}
# NOTE that we must not define command options here, but on the
# individual _macro_sub_* methods. Or at least we must not define
# any command options here that get passed to the _macro_sub_*
# methods.
sub macro : Verb() Tweak( -completion _readline_complete_subcommand ) {
my ( $self, undef, @args ) = __arguments( @_ ); # $opt unused
my $cmd;
if (!@args) {
$cmd = 'brief';
} elsif ( $self->{frame}[-1]{level1} ) {
if ($mac_cmd{$args[0]}) {
$cmd = $mac_cmd{shift @args};
} elsif (@args > 1) {
$cmd = 'define';
} else {
$cmd = 'list';
}
} else {
defined( $cmd = $mac_cmd{ $args[0] } )
or $cmd = $args[0];
shift @args;
}
my $code = $self->can( "_macro_sub_$cmd" )
or $self->wail( "Subcommand '$cmd' unknown" );
return $code->( $self, @args );
}
}
# Calls to the following _macro_sub_... methods are generated dynamically
# above, so there is no way Perl::Critic can find them.
sub _macro_sub_brief : Verb() Tweak( -completion _macro_list_complete ) { ## no critic (ProhibitUnusedPrivateSubroutines)
my ( $self, undef, @args ) = __arguments( @_ );
my $output;
foreach my $name (sort @args ? @args : keys %{$self->{macro}}) {
$self->{macro}{$name} and $output .= $name . "\n";
}
return $output;
}
sub _macro_sub_define : Verb( completion=s@ ) { ## no critic (ProhibitUnusedPrivateSubroutines)
my ( $self, $opt, $name, @args ) = __arguments( @_ );
my $output;
defined $name
or return $self->__wail( 'You must provide a name for the macro' );
@args
or return $self->__wail( 'You must provide a definition for the macro' );
$name !~ m/ \W /smx
and $name !~ m/ \A _ /smx
or return $self->__wail("Invalid macro name '$name'");
# NOTE the value of {def} used to be unescaped, but I do not now
# know why, and the implementation of \U and friends is more natural
# with this stripped out.
$self->{macro}{$name} =
Astro::App::Satpass2::Macro::Command->new(
name => $name,
parent => $self,
completion => $opt->{completion},
def => \@args,
generate => \&_macro_define_generator,
level1 => $self->{frame}[-1]{level1},
warner => $self->{_warner},
);
return $output;
}
sub _macro_define_generator {
my ( $self, @args ) = @_; # $self if Macro object
my $output;
foreach my $macro ( @args ) {
if ( my $comp = $self->completion() ) {
$output .= "macro define \\\n " .
"--completion '@$comp' \\\n " .
"$macro \\\n ";
} else {
$output .= "macro define $macro \\\n ";
}
$output .= join( " \\\n ", map { quoter( $_ ) } $self->def() ) .
"\n";
}
return $output;
}
sub _macro_sub_delete : Verb() Tweak( -completion _macro_list_complete ) { ## no critic (ProhibitUnusedPrivateSubroutines)
my ( $self, undef, @args ) = __arguments( @_ );
my $output;
foreach my $name (@args ? @args : keys %{$self->{macro}}) {
delete $self->{macro}{$name};
}
return $output;
}
sub _macro_sub_list : Verb() Tweak( -completion _macro_list_complete ) { ## no critic (ProhibitUnusedPrivateSubroutines)
my ( $self, undef, @args ) = __arguments( @_ );
my $output;
foreach my $name (sort @args ? @args : keys %{$self->{macro}}) {
$self->{macro}{$name}
or next;
$output .= $self->{macro}{$name}->generator( $name );
}
return $output;
}
sub _macro_sub_load : Verb( lib=s verbose! ) { ## no critic (ProhibitUnusedPrivateSubroutines)
my ( $self, $opt, $name, @args ) = __arguments( @_ );
my $output;
defined $name
or $self->wail( 'Must provide name of macro to load' );
my %marg = (
name => $name,
parent => $self,
generate => \&_macro_load_generator,
warner => $self->{_warner},
);
exists $opt->{lib}
and $marg{lib} = $opt->{lib};
my $obj = $self->{_macro_load}{$name} ||=
Astro::App::Satpass2::Macro::Code->new( %marg );
foreach my $mn ( @args ? @args : $obj->implements() ) {
$obj->implements( $mn, required => 1 )
and $self->{macro}{$mn} = $obj;
}
if ( $opt->{verbose} ) {
( my $fn = "$name.pm" ) =~ s| :: |/|smxg;
$output .= "Macro $name\n loaded from $INC{$fn}\n";
$output .= " implements:\n";
$output .= " $_\n" for sort $obj->implements();
}
$obj->implements( 'after_load', required => 0 )
and $output .= $self->dispatch( after_load => $opt, $name, @args );
return $output;
}
sub _macro_load_generator {
my ( $self, @args ) = @_;
my @preamble = qw{ macro load };
if ( $self->has_lib() ) {
push @preamble, '-lib', $self->lib();
$self->relative()
and push @preamble, '-relative';
}
push @preamble, $self->name();
my $output;
foreach my $macro ( @args ) {
$output .= quoter( @preamble, $macro ) . "\n";
}
return $output;
}
sub magnitude_table : Verb( name! reload! ) {
my ( undef, undef, @args ) = __arguments( @_ ); # Invocant, $opt unused
@args or @args = qw{show};
my $verb = lc (shift (@args) || 'show');
my $output;
if ( $verb eq 'show' || $verb eq 'list' ) {
my %data = Astro::Coord::ECI::TLE->magnitude_table( 'show', @args );
foreach my $oid ( sort keys %data ) {
$output .= quoter( 'status', 'add', $oid, $data{$oid} )
. "\n";
}
} else {
Astro::Coord::ECI::TLE->magnitude_table( $verb, @args );
}
return $output;
}
# Attributes must all be on one line to process correctly under Perl
# 5.8.8.
sub pass : Verb( :compute __pass_options ) {
my ( $self, $opt, @args ) = __arguments( @_ );
$opt->{ephemeris}
and $opt->{almanac} = 1;
$opt->{almanac}
and not defined $opt->{ephemeris}
and $opt->{ephemeris} = {
lib/Astro/App/Satpass2.pm view on Meta::CPAN
local $/ = undef;
return scalar <$fh>;
}
# $inx = $self->_find_in_sky( $name )
# The return is the index of the named body in @{ $self->{sky} }, or
# undef if it is not present. 'Sun' and 'Moon' are special cases;
# everything else is presumed to be found by name.
sub _find_in_sky {
my ( $self, $name ) = @_;
my $re = qr/ \A \Q$name\E \z /smxi;
foreach my $inx ( 0 .. $#{ $self->{sky} } ) {
$self->{sky}[$inx]->get( 'name' ) =~ $re
and return $inx;
}
return;
}
# Documented in POD
sub __format_data {
my ( $self, $action, $data, $opt ) = @_;
return $self->_get_formatter_object( $opt )->format(
sp => $self,
template => $action,
data => $data,
opt => $opt,
);
}
# $frames = $satpass2->_frame_push($type, \@args);
#
# This method pushes a context frame on the stack. The $type
# describes the frame, and goes in the frame's {type} entry, but
# is currently unused. The \@args entry goes in the {args} key,
# and is the basis of argument expansion. The return is the number
# of frames that were on the stack _BEFORE_ the now-current frame
# was added to the stack. This gets passed to _frame_pop() to
# restore the context stack to its status before the current frame
# was added.
sub _frame_push {
my ( $self, $type, $args, $opt ) = @_;
$args ||= [];
$opt ||= {};
my $frames = scalar @{$self->{frame} ||= []};
my $prior = $frames ? $self->{frame}[-1] : {
condition => 1,
stdout => select(),
};
my $condition = exists $opt->{condition} ?
$opt->{condition} :
$prior->{condition};
#### defined $stdout or $stdout = select();
my ( undef, $filename, $line ) = caller;
push @{$self->{frame}}, {
type => $type,
args => $args,
condition => $condition,
define => {}, # Macro defaults done with :=
local => {},
localout => undef, # Output for statement.
macro => {},
pushed_by => "$filename line $line",
spacetrack => {},
stdout => $prior->{localout} || $prior->{stdout},
unsatisfied_if => $prior->{unsatisfied_if} || ! $condition,
};
return $frames;
}
# $satpass2->_frame_pop($frames);
# $satpass2->_frame_pop($type => $frames);
# $satpass2->_frame_pop();
#
# This method pops context frames off the stack until there are
# $frames frames left. The optional $type argument is currently
# unused, but was intended for type checking should that become
# necessary. The zero-argument call pops one frame off the stack.
# An exception is thrown if there are no frames left to pop. After
# all required frames are popped, an exception is thrown if the
# pop was done with a continued input line pending.
{
my %force_set; # If true, the named attribute is set with the
# set() method even if a hash key of the same
# name exists. This is set with
# _frame_pop_force_set(), typically where the
# mutator is defined.
sub _frame_pop {
my ($self, @args) = @_;
## my $type = @args > 1 ? shift @args : undef;
@args > 1 and shift @args; # Currently unused
my $frames = ( @args && defined $args[0] ) ?
shift @args :
@{$self->{frame}} - 1;
while (@{$self->{frame}} > $frames) {
my $frame = pop @{$self->{frame}}
or $self->weep( 'No frame to pop' );
my $local = $frame->{local} || {};
foreach my $name ( keys %{ $local } ) {
my $value = $local->{$name};
if ( exists $self->{$name} && !$force_set{$name} ) {
$self->{$name} = $value;
} else {
$self->set( $name, $value );
}
}
foreach my $key (qw{macro}) {
my $info = $frame->{$key} || {};
foreach my $name ( keys %{ $info } ) {
$self->{$key}{$name} = $info->{ $name };
}
}
($frame->{spacetrack} && %{$frame->{spacetrack}})
and $self->_get_spacetrack()->set(%{$frame->{spacetrack}});
}
if (delete $self->{pending}) {
lib/Astro/App/Satpass2.pm view on Meta::CPAN
The C<-except> option causes the argument list to be used as an
exception list, and all attributes except those in the argument list are
localized. You can use C<-all> as a synonym for C<-except>; it may look
more natural when there are no arguments.
=head2 location
$output = $satpass2->location();
satpass2> location
This interactive method returns the current location.
=head2 macro
$output = $satpass2->macro( $subcommand, $arg ...);
satpass2> macro subcommand arg ...
This interactive method manipulates macros. The following subcommands
are available:
'brief' lists the names of defined macros;
'list' lists the definitions of macros;
'delete' deletes macros;
'define' defines a command macro;
'load' loads a code macro.
For semi-compatibility backward, each of these except C<'load'> can be
specified with a leading dash (e.g. '-delete'). With the leading dash
specified, subcommands can be abbreviated as long as the abbreviation is
unique. For example, '-del' is equivalent to 'delete', but 'del' is
not. This compatibility functionality will go away when support for
compatibility with the F<satpass> script does.
If no arguments at all are provided to C<macro()>, 'brief' is assumed.
If a single argument is provided that does not match a subcommand name,
'list' is assumed.
If more than one argument is provided, and the first does not match a
subcommand name, 'define' is assumed.
The first argument of the 'define' subcommand is the macro name, and
subsequent arguments are the commands that make up that macro. For
example, 'say' can be defined in terms of 'echo' by
$satpass2->macro( define => say => 'echo $@' );
The C<'define'>> subcommand supports the following options:
=over
=item -completion
This option specifies a space-delimited list of completions for the
macro arguments. It can be specified more than once, in which case all
completion specifications will be concatenated.
=back
The first argument of the C<'load'> subcommand is the name of a Perl
module (e.g. C<My::Macros>) that implements one or more code macros.
Subsequent arguments, if any, are the names of macros to load from the
module. If no subsequent arguments are given, all macros defined by the
macro are loaded.
The C<'load'> subcommand supports the following options:
=over
=item -lib
-lib ~/lib
This option specifies a directory from which to load macro modules. The
value is added to C<@INC> before the code macro is loaded.
The default is the F<lib/> subdirectory of the user's configuration
directory.
=item -verbose
This option specifies that extra output be generated if the load is
successful. This output will appear before any output from the
C<after_load> macro if any.
This option is intended as a debugging aid, and the output generated by
it may change without notice.
=back
Code macros are experimental. See
L<Astro::App::Satpass2::TUTORIAL|Astro::App::Satpass2::TUTORIAL> for how
to write one.
For subcommands other than C<'define'> and C<'load'>, the arguments are
macro names.
The C<brief> and C<list> subcommands return their documented output. The
C<delete> and C<define> subcommands return nothing.
Macros can be called programmatically via the L<dispatch()|/dispatch>
method.
=head2 magnitude_table
$output = $satpass2->magnitude_table( $subcommand, ... );
satpass2> magnitude_table subcommand ...
This interactive method manipulates the satellite magnitude table. This
provides intrinsic magnitudes for satellites loaded via the
L<load()|/load> method. The arguments are a subcommand (defaulting to
'show'), and possibly further arguments that depend on that subcommand.
Briefly, the valid subcommands are:
C<add> - adds a body's magnitude to the table, possibly replacing an existing
entry. The arguments are OID and intrinsic magnitude, the latter defined
as the magnitude at range 1000 kilometers when half illuminated.
C<adjust> - If an argument is given, provides an adjustment to the
magnitude table data when loading TLE data. This adjustment, in
magnitudes, is added to whatever value is in the table. If no argument
is given, returns the current adjustment.
C<clear> - clears the magnitude table.
C<drop> - drops an entry from the magnitude table. The argument is the OID.
C<list> - a synonym for C<show>.
C<magnitude> - Load the magnitude table from a hash (not available
interactively). The loaded data replace whatever was there before.
C<molczan> - Load the magnitude table from a Molczan-format data file.
The loaded data replace whatever was there before.
C<molczan> - Load the magnitude table from a Quicksat-format data file.
The loaded data replace whatever was there before.
C<show> - displays the magnitude table, formatted as a series of
C<'magnitude_table add'> commands.
This method is really just a front-end for the
L<Astro::Coord::ECI::TLE|Astro::Coord::ECI::TLE> C<magnitude_table()>
method. See the documentation for that for more details.
=head2 pass
$output = $satpass2->pass( 'today 12:00:00', '+7' );
satpass2> pass 'today 12:00:00' +7
This interactive method computes and returns the visible passes of any
bodies in the observing list. The optional arguments are the start time of
the prediction (defaulting to the current day at noon) and the end time
of the prediction (defaulting to C<'+7'>). See L</SPECIFYING TIMES> for
how to specify times.
The following options are available:
C<-almanac> requests the inclusion of illuminating body rise/set and
begin/end twilight times. These will be applied only to the last AM
event of the day, and the first PM event of the day. Unless the
( run in 0.573 second using v1.01-cache-2.11-cpan-75ffa21a3d4 )