File Coverage

blib/lib/Astro/App/Satpass2.pm

Criterion	Covered	Total	%
statement	1667	2468	67.5
branch	625	1338	46.7
condition	168	423	39.7
subroutine	276	350	78.8
pod	59	63	93.6
total	2795	4642	60.2

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();
	1;
    }
	or do {
	    require Time::Local;
	    Time::Local->import();
	};
}

# The following is returned by method _attribute_value() when a
# non-existent attribute is specified. We can't use undef for this,
# because the attribute might really be undef.
# NOTE that this used to be just bless \( $x = undef ) ..., but blead
# Perl 6a011f13d7690dbe2e03ad7500756c983bcb1834 did not like this
# (modificatoin of read-only variable).
use constant NULL	=> do {
    my $x = undef;
    bless \$x, 'Null';
};
# The canonical way to see if $rslt actually contains the above is
# NULL_REF eq ref $rslt
use constant NULL_REF	=> ref NULL;

use constant SUN_CLASS_DEFAULT	=> 'Astro::Coord::ECI::Sun';

our $VERSION = '0.057';

# The following 'cute' code is so that we do not determine whether we
# actually have optional modules until we really need them, and yet do
# not repeat the process once it is done.

my $have_time_hires;
$have_time_hires = sub {
    my $value = load_package( 'Time::HiRes' );
    $have_time_hires = sub { return $value };
    return $value;
};

my $have_astro_spacetrack;
$have_astro_spacetrack = sub {
    my $value = load_package( { lib => undef }, 'Astro::SpaceTrack' ) && eval {
	Astro::SpaceTrack->VERSION( ASTRO_SPACETRACK_VERSION );
	1;
    };
    $have_astro_spacetrack = sub { $value };
    return $value;
};

my $default_geocoder;
$default_geocoder = sub {
    my $value =
	_can_use_geocoder( 'Astro::App::Satpass2::Geocode::OSM'
	);
    $default_geocoder = sub { return $value };
    return $value;
};

sub _can_use_geocoder {
    my ( $geocoder ) = @_;
    my $pkg = load_package( $geocoder )
	or return;
    load_package( $pkg->GEOCODER_CLASS() )
	or return;
    return $pkg;
}

my $interrupted = 'Interrupted by user.';

my %twilight_def = (
    civil => deg2rad (-6),
    nautical => deg2rad (-12),
    astronomical => deg2rad (-18),
);
my %twilight_abbr = abbrev (keys %twilight_def);

#	Individual commands are defined by subroutines of the same name,
#	and having the Verb attribute. You can specify additional
#	attributes if you need to. Following are descriptions of the
#	attributes used by  this script.
#
#	Configure(configurations)
#
#	The 'Configure' attribute specifies options to be passed to
#	Getopt::Long::Configure before the options are parsed. For
#	example, if a command wants to keep unrecognized options on the
#	command you would specify:
#	    sub foo : Configure(pass_through) Verb
#
#	Tokenize(options)
#
#	The 'Tokenize' attribute specifies tokenizatino options. These
#	can not take effect until fairly late in the parse when the
#	tokens are known. These options are parsed by Getopt::Long, and
#	the value of the attribute is a reference to the options hash
#	thus generated. Possible options are:
#	  -expand_tilde - Expand tildes in the tokens. For historical
#		reasons this is the default, but it can be negated by
#		specifying -noexpand_tilde. Tildes in redirect
#		specifications are always expanded.
#
#	Tweak(options)
#
#	The 'Tweak' attribute specifies miscellaneous tweaks to
#	subroutine usage. Possible options are:
#	  -unsatisfied - Execute even inside an unsatisfied if().
#		Subroutines with this attribute may have to be aware
#		that they are being called within the scope of an
#		unsatisfied if(). All interactive methods that must be
#		called even inside an unsatisfied if() MUST have this
#		attribute. These are begin() and end(), and anything
#		that might dispatch either of these. At the moment this
#		means if() and time().
#	  -completion - Requires as argument the name of the command
#	        completion method. This can not be checked at compile
#	        time. It will be called with the following arguments:
#	        $code - the relevant code reference
#	        $text - the text being completed
#	        $line - the line being completed
#	        $start - the current position in the line.
#	        It should return either a reference to an array
#	        containing possible completions, or nothing to fall
#	        through to standard completion
#
#	Verb(options)
#
#	The 'Verb' attribute identifies the subroutine as representing a
#	cvsx command. If it has options, they should be specified inside
#	parentheses as a whitespace-separated list of option
#	specifications appropriate for Getopt::Long. For example:
#	    sub foo : Verb(bar baz=s)
#	specifies that 'foo' is a command, taking options -bar, and
#	-baz; the latter takes a string value.

{
    my %attr;

    sub Configure : ATTR(CODE,RAWDATA) {
	my ( undef, undef, $code, $name, $data ) = @_;
	$attr{$code}{$name} = _attr_list( $data );
	return;
    }

    sub Tokenize : ATTR(CODE,RAWDATA) {
	my ( undef, undef, $code, $name, $data ) = @_;
	my $opt = _attr_hash( $name, $data, qw{ expand_tilde|expand-tilde! } );
	exists $opt->{expand_tilde}
	    or $opt->{expand_tilde} = 1;
	$attr{$code}{$name} = $opt;
	return;
    }

    sub Tweak : ATTR(CODE,RAWDATA) {
	my ( undef, undef, $code, $name, $data ) = @_;
	$attr{$code}{$name} = _attr_hash( $name, $data,
	    qw{ completion=s unsatisfied! } );
	return;
    }

    sub Verb : ATTR(CODE,RAWDATA) {
	my ( undef, undef, $code, $name, $data ) = @_;
	$attr{$code}{$name} = _attr_list( $data );
	return;
    }

    sub _attr_hash {
	my ( $name, $arg, @legal ) = @_;
	my $gol = Getopt::Long::Parser->new();
	my %opt;
	$gol->getoptionsfromarray(
	    _attr_list( $arg ),
	    \%opt,
	    @legal,
	) or do {
	    require Carp;
	    Carp::croak( "Bad $name option" );
	};
	return \%opt;
    }

    sub _attr_list {
	defined( local $_ = $_[0] )
	    or return [];
	s/ \A \s+ //smx;
	return [ split qr< \s+ >smx ];
    }

    sub __get_attr {
	my ( undef, $code, $name, $dflt ) = @_;	# $pkg unused
	defined $code
	    or return \%attr;
	defined $name
	    or return $attr{$code};
	exists $attr{$code}{$name}
	    and return $attr{$code}{$name};
	return $dflt;
    }
}

my %mutator = (
    almanac_horizon	=> \&_set_almanac_horizon,
    appulse => \&_set_angle,
    autoheight => \&_set_unmodified,
    backdate => \&_set_unmodified,
    background => \&_set_unmodified,
    continuation_prompt => \&_set_unmodified,
    country => \&_set_unmodified,
    date_format => \&_set_formatter_attribute,
    desired_equinox_dynamical => \&_set_formatter_attribute,
    debug => \&_set_unmodified,
    echo => \&_set_unmodified,
    edge_of_earths_shadow => \&_set_unmodified,
    ellipsoid => \&_set_ellipsoid,
    error_out => \&_set_unmodified,
    events	=> \&_set_unmodified,
    exact_event => \&_set_unmodified,
    execute_filter => \&_set_code_ref,	# Undocumented and unsupported
    explicit_macro_delete => \&_set_unmodified,
    extinction => \&_set_unmodified,
    filter => \&_set_unmodified,
    flare_mag_day => \&_set_unmodified,
    flare_mag_night => \&_set_unmodified,
    formatter => \&_set_formatter,
    geocoder => \&_set_geocoder,
    geometric => \&_set_unmodified,
    gmt => \&_set_formatter_attribute,
    height => \&_set_distance_meters,
    horizon => \&_set_angle,
    illum	=> \&_set_illum_class,
    latitude => \&_set_angle_or_undef,
    local_coord => \&_set_formatter_attribute,
    location => \&_set_unmodified,
    longitude => \&_set_angle_or_undef,
    model => \&_set_model,
    max_mirror_angle => \&_set_angle,
    output_layers	=> \&_set_output_layers,
    pass_threshold => \&_set_angle_or_undef,
    pass_variant	=> \&_set_pass_variant,
    perltime => \&_set_time_parser_attribute,
    prompt => \&_set_unmodified,
    refraction	=> \&_set_unmodified,
    simbad_url => \&_set_unmodified,
    singleton => \&_set_unmodified,
    spacetrack => \&_set_spacetrack,
    stdout => \&_set_stdout,
    sun	=> \&_set_sun_class,		# Only in {level1}
    time_format => \&_set_formatter_attribute,
    time_formatter => \&_set_formatter_attribute,
    time_parser => \&_set_time_parser,
##    timing => \&_set_unmodified,
    twilight => \&_set_twilight,  # 'civil', 'nautical', 'astronomical'
				# (or a unique abbreviation thereof),
				# or degrees above (positive) or below
				# (negative) the geometric horizon.
    tz => \&_set_tz,
    verbose => \&_set_unmodified, # 0 = events only
				# 1 = whenever above horizon
				# 2 = anytime
    visible => \&_set_unmodified, # 1 = only if sun down & sat illuminated
    warning => \&_set_warner_attribute,	# True to warn/die; false to carp/croak.
    warn_on_empty => \&_set_unmodified,
    				# True to have list commands warn on
				# an empty list.
    webcmd => \&_set_webcmd,	# Command to spawn for web pages
);

my %accessor = (
    date_format => \&_get_formatter_attribute,
    desired_equinox_dynamical => \&_get_formatter_attribute,
    geocoder => \&_get_geocoder,
    gmt => \&_get_formatter_attribute,
    local_coord => \&_get_formatter_attribute,
    perltime => \&_get_time_parser_attribute,
    spacetrack => \&_get_spacetrack,
    time_format => \&_get_formatter_attribute,
    time_formatter	=> \&_get_formatter_attribute,
    tz => \&_get_time_parser_attribute,
    warning => \&_get_warner_attribute,
);

foreach ( keys %mutator, qw{ initfile } ) {
    $accessor{$_} ||= sub { return $_[0]->{$_[1]} };
}

my %shower = (
    date_format => \&_show_formatter_attribute,
    desired_equinox_dynamical => \&_show_formatter_attribute,
    formatter	=> \&_show_copyable,
    geocoder	=> \&_show_copyable,
    gmt => \&_show_formatter_attribute,
    local_coord => \&_show_formatter_attribute,
    pass_variant	=> \&_show_pass_variant,
    sun		=> \&_show_sun_class,	# only in {level1}
    time_parser => \&_show_time_parser,
    time_format => \&_show_formatter_attribute,
    time_formatter	=> \&_show_formatter_attribute,
);
foreach ( keys %accessor ) { $shower{$_} ||= \&_show_unmodified }

#	Attributes which must be set programmatically (i.e. not
#	interactively or in the initialization file).

my %nointeractive = map {$_ => 1} qw{
    execute_filter
    spacetrack
    stdout
};

#	Initial object contents

my %static = (
    almanac_horizon	=> 0,
    appulse => 0,
    autoheight => 1,
    background => 1,
    backdate => 0,
    continuation_prompt => '> ',
    date_format => '%a %d-%b-%Y',
    debug => 0,
    echo => 0,
    edge_of_earths_shadow => 1,
    ellipsoid => Astro::Coord::ECI->get ('ellipsoid'),
    error_out => 0,
    events	=> 0,
    exact_event => 1,
    execute_filter => sub { return 1 },	# Undocumented and unsupported
##  explicit_macro_delete => 1,			# Deprecated
    extinction => 1,
    filter => 0,
    flare_mag_day => -6,
    flare_mag_night => 0,
    formatter => 'Astro::App::Satpass2::Format::Template',	# Formatter class.
##  geocoder => $default_geocoder->(),	# Geocoder class set when accessed
    geometric => 1,
    height => undef,		# meters
#   initfile => undef,		# Set by init()
    horizon => 20,		# degrees
    illum	=> SUN_CLASS_DEFAULT,
    latitude => undef,		# degrees
    longitude => undef,		# degrees
    max_mirror_angle => HAVE_TLE_IRIDIUM ? rad2deg(
	Astro::Coord::ECI::TLE::Iridium->DEFAULT_MAX_MIRROR_ANGLE ) :
	undef,
    model => 'model',
#   pending => undef,		# Continued input line if it exists.
    pass_variant	=> PASS_VARIANT_NONE,
    perltime => 0,
    prompt => 'satpass2> ',
    refraction	=> 1,
    simbad_url => 'simbad.u-strasbg.fr',
    singleton => 0,
#   spacetrack => undef,	# Astro::SpaceTrack object set when accessed
#   stdout => undef,		# Set to stdout in new().
    output_layers	=> DEFAULT_STDOUT_LAYERS,
    time_parser => 'Astro::App::Satpass2::ParseTime',	# Time parser class.
    twilight => 'civil',
    tz => $ENV{TZ},
    verbose => 0,
    visible => 1,
    warning => 0,
    warn_on_empty => 1,
    webcmd => ''
);

my %sky_class = (
    fold_case( 'Sun' ) => [ SUN_CLASS_DEFAULT, name => 'Sun' ],
    fold_case( 'Moon' ) => [ 'Astro::Coord::ECI::Moon', name => 'Moon' ],
#    # The shape of things to come -- maybe
#    # but commented out because Astro-App-Satpass2 does not depend on
#    # these
#    ( map { fold_case( $_ ) =>
#	"Astro::Coord::ECI::VSOP87D::$_" } qw{ Mercury Venus
#	Mars Jupiter Saturn Uranus Neptune } ),
);

sub new {
    my ( $class, %args ) = @_;
    ref $class and $class = ref $class;
    my $self = {};
    $self->{bodies} = [];
    $self->{macro} = {};
    $self->{sky} = [
	SUN_CLASS_DEFAULT->new (),
	Astro::Coord::ECI::Moon->new (),
    ];
    $self->{sky_class} = { %sky_class };
    $self->{_help_module} = {
	''	=> __PACKAGE__,
	eci => 'Astro::Coord::ECI',
	moon => 'Astro::Coord::ECI::Moon',
	set => 'Astro::Coord::ECI::TLE::Set',
	sun => SUN_CLASS_DEFAULT,
	spacetrack => 'Astro::SpaceTrack',
	star => 'Astro::Coord::ECI::Star',
	tle => 'Astro::Coord::ECI::TLE',
	utils => 'Astro::Coord::ECI::Utils',
    };
    HAVE_TLE_IRIDIUM
	and $self->{_help_module}{iridium} = 'Astro::Coord::ECI::TLE::Iridium';
    bless $self, $class;
    $self->_frame_push(initial => []);
    $self->set(stdout => select());

    foreach my $name ( keys %static ) {
	exists $args{$name} or $args{$name} = $static{$name};
    }

    $self->{_warner} = Astro::App::Satpass2::Warner->new(
	warning => delete $args{warning}
    );

    foreach my $name ( qw{ formatter time_parser } ) {
	$self->set( $name => delete $args{$name} );
    }

    $self->set( %args );

    return $self;
}

sub add {
    my ( $self, @bodies ) = @_;
    foreach my $body ( @bodies ) {
	embodies( $body, 'Astro::Coord::ECI::TLE' )
	    or $self->wail(
	    'Arguments must represent Astro::Coord::ECI::TLE objects' );
    }
    push @{ $self->{bodies} }, @bodies;
    return $self;
}

sub alias : Verb() {
    my ( undef, undef, @args ) = __arguments( @_ );	# Invocant, $opt unused

    if ( @args ) {
	Astro::Coord::ECI::TLE->alias( @args );
	return;
    } else {
	my $output;
	my %alias = Astro::Coord::ECI::TLE->alias();
	foreach my $key ( sort keys %alias ) {
	    $output .= join( ' ', 'alias', $key, $alias{$key} ) . "\n";
	}
	return $output;
    }
}

# Attributes must all be on one line to process correctly under Perl
# 5.8.8.
sub almanac : Verb( choose=s@ dump! horizon|rise|set! transit! twilight! quarter! ) {
    my ( $self, $opt, @args ) = __arguments( @_ );
    $self->_apply_boolean_default(
	$opt, 0, qw{ horizon transit twilight quarter } );

    my $almanac_start = $self->__parse_time(
	shift @args, $self->_get_day_midnight());
    my $almanac_end = $self->__parse_time (shift @args || '+1');

    $almanac_start >= $almanac_end
	and $self->wail( 'End time must be after start time' );

#	Build an object representing our ground location.

    my $sta = $self->station();

    my @almanac;

#	Iterate through the background bodies, accumulating data or
#	complaining about the lack of an almanac() method as
#	appropriate.

    my @sky = $self->__choose( $opt->{choose}, $self->{sky} )
	or return $self->__wail( 'No bodies selected' );

    foreach my $body ( @sky ) {
	$body->can ('almanac') or do {
	    $self->whinge(
		ref $body, ' does not support the almanac method');
	    next;
	};
	$body->set (
	    station	=> $sta,
	    twilight	=> $self->{_twilight},
	);
	push @almanac, $body->almanac_hash(
	    $almanac_start, $almanac_end);
    }

    # Record number of events found

    @almanac = grep { $opt->{$_->{almanac}{event}} } @almanac;
    $self->{events} += @almanac;

    # Localize the event descriptions if appropriate.

    _almanac_localize( @almanac );

#	Sort the almanac data by date, and display the results.

    return $self->__format_data(
	almanac => [
	    sort { $a->{time} <=> $b->{time} }
	    @almanac
	], $opt );

}
sub _almanac_localize {
    my @almanac = @_;
    foreach my $event ( @almanac ) {
	$event->{almanac}{description} = __localize(
	    text	=> [ almanac => $event->{body}->get( 'name' ),
		$event->{almanac}{event}, $event->{almanac}{detail} ],
	    default	=> $event->{almanac}{description},
	    argument	=> $event->{body},
	);
    }
    return;
}

sub begin : Verb() Tweak( -unsatisfied ) {
    my ( $self, $opt, @args ) = __arguments( @_ );
    $self->_frame_push(
	begin => @args ? \@args : $self->{frame}[-1]{args});
    $self->{frame}[-1]{level1} = $opt->{level1};
    return;
}

# -level1 is UNSUPPORTED and may be removed without warning. It is only
# there for me to screw around with.
BEGIN {
    $ENV{SATPASS2_LEVEL1}
	and __PACKAGE__->MODIFY_CODE_ATTRIBUTES(
	\&begin,
	'Verb( level1! )',
    );
}

sub cd : Verb() {
    my ( $self, undef, $dir ) = __arguments( @_ );	# $opt unused
    if (defined($dir)) {
	chdir $dir or $self->wail("Can not cd to $dir: $!");
    } else {
	chdir File::HomeDir->my_home()
	    or $self->wail("Can not cd to home: $!");
    }
    return;
}

sub choose : Verb( epoch=s ) {
    my ( $self, $opt, @args ) = __arguments( @_ );

    if ($opt->{epoch}) {
	my $epoch = $self->__parse_time($opt->{epoch});
	$self->{bodies} = [
	map {
	    $_->select($epoch);
	}
	$self->_aggregate( $self->{bodies} )
	];
    }
    if ( @args ) {
	my @bodies = @{ $self->__choose( \@args, $self->{bodies} ) }
	    or return $self->__wail( 'No bodies chosen' );
	@{ $self->{bodies} } = @bodies;
    }
    return;
}

sub clear : Verb() {
    my ( $self ) = __arguments( @_ );	# $opt, @args unused
    @{$self->{bodies}} = ();
    return;
}

sub dispatch {
    my ($self, $verb, @args) = @_;

    defined $verb or return;

    my $unsatisfied = $self->_in_unsatisfied_if();

    if ( $self->{macro}{$verb} ) {
	$unsatisfied
	    and return;
	return $self->_macro( $verb, @args );
    }

    my $code;
    $verb =~ s/ \A core [.] //smx;
    $code = $self->can($verb)
	and $self->__get_attr($code, 'Verb')
	or $self->wail("Unknown interactive method '$verb'");

    my $rslt;
    $unsatisfied
	and not $self->__get_attr( $code, Tweak => {} )->{unsatisfied}
	or $rslt = $code->( $self, @args );

    defined $rslt
	and $rslt =~ s/ (?

    foreach my $code (
	reverse @{ delete( $self->{frame}[-1]{post_dispatch} ) || [] }
    ) {
	my $append;
	defined( $append = $code->( $self ) )
	    and $rslt .= $append;
    }
    return $rslt;
}

{
    my %special = (
	begin	=> sub {
	    my ( $self, $verb ) = @_;
	    $self->_is_interactive()
		or $self->wail(
		"'begin' forbidden in non-interactive $verb()" );
	    return;
	},
	end	=> sub {
	    my ( $self, $verb ) = @_;
	    $self->wail( "'end' forbidden in $verb()" );
	},
    );

    sub _dispatch_check {
	my ( $self, $verb, $disp ) = @_;
	my $code = $special{$disp}
	    or return;
	return $code->( $self, $verb, $disp );
    }
}

sub drop : Verb() {
    my ( $self, undef, @args ) = __arguments( @_ );	# $opt unused

    @args
	or return;

    my @bodies = @{
	$self->__choose( { invert => 1 }, \@args, $self->{bodies} ) }
	or return $self->__wail( 'No bodies left' );

    @{ $self->{bodies} } = @bodies;

    return;
}

sub dump : method Verb() Tweak( -unsatisfied ) {	## no critic (ProhibitBuiltInHomonyms)
    my ( $self, undef, @arg ) = __arguments( @_ );	# $opt unused

    local $self->{time_parser} = ref $self->{time_parser};

    my $dumper = $self->_get_dumper();

    @arg
	or return $dumper->( $self );

    local $_ = shift @arg;

    ref
	and return $dumper->( $_ );

    m/ \A frames? \z /smxi
	and return $dumper->( $self->{frame} );

    m/ \A tokens? \z /smxi
	and return $dumper->( $self->__tokenize( @arg ) );

    m/ \A twilight \z /smxi
	and return $dumper->(
	{ map { $_ => $self->{$_} } qw{ twilight _twilight } } );

    my @stuff = $self->__choose( [ $_ ], $self->{bodies} );
    if ( defined( my $inx = $self->_find_in_sky( $_ ) ) ) {
	push @stuff, $self->{sky}[$inx];
    }
    @stuff
	and return $dumper->( @stuff );

    $self->whinge( "Dump argument '$_' not recognized" );

    return;
}

sub echo : Verb( n! ) {
    my ( undef, $opt, @args ) = __arguments( @_ );	# Invocant unused
    my $output = join( ' ', @args );
    $opt->{n} or $output .= "\n";
    return $output;
}

sub else : method Verb() Tweak( -unsatisfied ) {	## no critic (ProhibitBuiltInHomonyms)
    my ( $self ) = __arguments( @_ );	# $opt, @args unused

    @{ $self->{frame} } > 1
	and 'begin' eq $self->{frame}[-1]{type}
	and 'if' eq $self->{frame}[-2]{type}
	or $self->wail( 'Else without if ... then begin' );

    $self->{frame}[-1]{in_else}++
	and $self->wail( 'Only one else may follow an if' );

    return $self->_twiddle_condition( ! $self->{frame}[-2]{condition} );
}

sub _twiddle_condition {
    my ( $self, $cond ) = @_;

    # Here is where I pay for the convenience of the if()
    # implementation. The if() itself is a frame because I do not yet
    # know if it will entail a begin(). But I can't do an else() unless
    # there is in fact a begin(), which creates another frame. So I end
    # up twiddling values in both frames.

    $self->{frame}[-1]{unsatisfied_if} =
	$self->{frame}[-2]{unsatisfied_if} =
	! $cond || (
	    @{ $self->{frame} } > 2 ?
		$self->{frame}[-3]{unsatisfied_if} :
		0
	    );

    $self->{frame}[-1]{condition} =
	$self->{frame}[-2]{condition} = $cond;

    return;
}

sub end : Verb() Tweak( -unsatisfied ) {
    my ( $self ) = __arguments( @_ );	# $opt, @args unused

    $self->{frame}[-1]{type} eq 'begin'
	or $self->wail( 'End without begin' );
    $self->_frame_pop();
    return;
}

sub error : Verb() {
    my ( $self, undef, @arg ) = __arguments( @_ );
    @arg
	or push @arg, 'An error has occurred';
    $self->wail( @arg );
    return;
}

# Tokenize and execute one or more commands. Optionally (and
# unsupportedly) you can pass a code reference as the first argument.
# This code reference will be used to fetch commands when the arguments
# are exhausted. IF you pass your own code reference, we return after
# the first command, since the code reference is presumed to manage the
# input stream itself.
sub execute {
    my ($self, @args) = @_;
    my $accum;
    my $in;
    my $extern;
    if ( CODE_REF eq ref $args[0] ) {
	$extern = shift @args;
	$in = sub {
	    my ( $prompt ) = @_;
	    @args and return shift @args;
	    return $extern->( $prompt );
	};
    } else {
	$in = sub { return shift @args };
    }
    @args = map { split qr{ (?<= \n ) }smx, $_ } @args;
    while ( defined ( local $_ = $in->( $self->get( 'prompt' ) ) ) ) {
	$self->{echo} and $self->whinge($self->get( 'prompt' ), $_);
	m/ \A \s* [#] /smx and next;
	my $stdout = $self->{frame}[-1]{stdout};
	my ($args, $redirect) = $self->__tokenize(
	    { in => $in }, $_, $self->{frame}[-1]{args});
	# NOTICE
	#
	# The execute_filter attribute is undocumented and unsupported.
	# It exists only so I can scavenge the user's initialization
	# file for the (possible) Space Track username and password, to
	# be used in testing, without being subject to any other
	# undesired side effects, such as running a prediction and
	# exiting. If I change my mind on how or whether to do this,
	# execute_filter will be altered or retracted without warning,
	# much less a deprecation cycle. If you have a legitimate need
	# for this functionality, contact me.
	#
	# YOU HAVE BEEN WARNED.
	$self->{execute_filter}->( $self, $args ) or next;
	@{ $args } or next;
	if ($redirect->{'>'}) {
	    my ( $mode, $name ) = map { $redirect->{'>'}{$_} } qw{ mode name };
	    my $fh;
	    $stdout = sub {
		my ( $output ) = @_;
		$fh ||= $self->_file_opener( $name, $mode );
		$fh->print( $output );
		return;
	    };
	}

	# {localout} is the output to be used for this command. It goes
	# in the frame stack because our command may start a new frame,
	# and _frame_push() needs to have a place to get the correct
	# output handle.

	my $frame_depth = $#{$self->{frame}};
	$self->{frame}[-1]{localout} = $stdout;

	my $output = $self->dispatch( @$args );

	$#{$self->{frame}} >= $frame_depth
	    and delete $self->{frame}[ $frame_depth ]{localout};

	$self->_execute_output( $output,
	    defined $stdout ? $stdout : \$accum );

	$extern and last;
    }
    return $accum;
}

#	$satpass2->_execute(...);
#
#	This subroutine calls $satpass2->execute() once for each
#	argument. The call is wrapped in an eval{}; if an exception
#	occurs the user is notified via warn.

sub _execute {
    my ($self, @args) = @_;
    my $in = CODE_REF eq ref $args[0] ? shift @args : sub { return shift
	@args };
    while ( @args ) {
	local $SIG{INT} = sub {die "\n$interrupted\n"};
	eval {
	    $self->execute( $in, shift @args );
	    1;
	} or warn $@;	# Not whinge, since presumably we already did.
    }
    return;
}

#	$satpass2->_execute_output( $output, $stdout );
#
#	If $output is defined, sends it to $stdout.

sub _execute_output {
    my ( undef, $output, $stdout ) = @_;	# Invocant unused
    defined $output or return;
    my $ref = ref $stdout;
    if ( !defined $stdout ) {
	return $output;
    } elsif ( SCALAR_REF eq $ref ) {
	$$stdout .= $output;
    } elsif ( CODE_REF eq $ref ) {
	$stdout->( $output );
    } elsif ( ARRAY_REF eq $ref ) {
	push @$stdout, split qr{ (?<=\n) }smx, $output;
    } else {
	$stdout->print( $output );
    }
    return;
}

sub exit : method Verb() {	## no critic (ProhibitBuiltInHomonyms)
    my ( $self ) = __arguments( @_ );	# $opt, @args unused

    $self->_frame_pop(1);	# Leave only the inital frame.

    eval {	## no critic (RequireCheckingReturnValueOfEval)
	no warnings qw{exiting};
	last SATPASS2_EXECUTE;
    };
    $self->whinge("$@Exiting Perl");
    exit;

}

sub export : Verb() {
    my ( $self, undef, $name, @args ) = __arguments( @_ );	# $opt unused
    if ($mutator{$name}) {
	@args and $self->set ($name, shift @args);
	$self->{exported}{$name} = 1;
    } else {
	@args or return $self->wail( 'You must specify a value' );
	$self->{exported}{$name} = shift @args;
    }
    return;
}

# Attributes must all be on one line to process correctly under Perl
# 5.8.8.
sub flare : Verb( algorithm=s am! choose=s@ day! dump! pm! questionable|spare! quiet! tz|zone=s )
{
    my ( $self, $opt, @args ) = __arguments( @_ );
    HAVE_TLE_IRIDIUM
	or $self->wail( 'Astro::Coord::ECI::TLE::Iridium not available' );
    my $pass_start = $self->__parse_time (
	shift @args, $self->_get_day_noon());
    my $pass_end = $self->__parse_time (shift @args || '+7');
    $pass_start >= $pass_end
	and $self->wail( 'End time must be after start time' );
    my $sta = $self->station();

    my $max_mirror_angle = deg2rad( $self->{max_mirror_angle} );
    my $horizon = deg2rad ($self->{horizon});
    my $twilight = $self->{_twilight};
    my @flare_mag = ($self->{flare_mag_night}, $self->{flare_mag_day});
    my $zone = exists $opt->{tz} ? $opt->{tz} :
	$self->{formatter}->gmt() ? 0 :
	$self->{formatter}->tz() || undef;

    $self->_apply_boolean_default(
	$opt, 0, qw{ am day pm } );

#	Decide which model to use.

    my $model = $self->{model};

#	Select only the bodies capable of flaring.

    my @active;
    foreach my $tle ( $self->_aggregate(
	    scalar $self->__choose( $opt->{choose}, $self->{bodies} )
	) )
    {
	$tle->can_flare( $opt->{questionable} ) or next;
	$tle->set (
	    algorithm	=> $opt->{algorithm} || 'fixed',
	    backdate	=> $self->{backdate},
	    edge_of_earths_shadow => $self->{edge_of_earths_shadow},
	    horizon	=> $horizon,
	    twilight	=> $twilight,
	    model	=> $model,
	    am		=> $opt->{am},
	    max_mirror_angle => $max_mirror_angle,
	    day		=> $opt->{day},
	    pm		=> $opt->{pm},
	    extinction	=> $self->{extinction},
	    station	=> $sta,
	    zone	=> $zone,
	);
	push @active, $tle;
    }
    @active or return $self->__wail( 'No bodies capable of flaring' );

    my @flares;
    foreach my $tle (@active) {
	eval {
	    push @flares, $tle->flare( $pass_start, $pass_end );
	    1;
	} or do {
	    $@ =~ m/ \Q$interrupted\E /smxo and $self->wail($@);
	    $opt->{quiet} or $self->whinge($@);
	};
    }

    # Record number of events found

    @flares = sort { $a->{time} <=> $b->{time} }
	    grep { $_->{magnitude} <= $flare_mag[
	    ( $_->{type} eq 'day' ? 1 : 0 ) ] }
	    @flares;
    $self->{events} += @flares;

    return $self->__format_data( flare => \@flares, $opt );
}

sub formatter : Verb() Tweak( -completion _readline_complete_subcommand ) {
    splice @_, ( HASH_REF eq ref $_[1] ? 2 : 1 ), 0, 'formatter';
    goto &_helper_handler;
}

# Calls to the following _formatter_sub method are generated dynamically
# above, so there is no way Perl::Critic can find them.

sub _formatter_sub {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ( $app, $text, $line, $start, @arg ) = @_;
    my $fmtr = $app->get( 'formatter' );
    if ( @arg == 2 ) {
	my @list = qw{
	    date_format
	    desired_equinox_dynamical
	    gmt
	    local_coord
	    time_format
	    tz
	};
	$fmtr->can( '__list_templates' )
	    and push @list, 'template';
	my $re = qr/ \A \Q$arg[1]\E /smx;
	return [ grep { $_ =~ $re } sort @list ];
    }
    my $code = $app->can( "_formatter_complete_$arg[1]" )
	or return;

    my $r;
    $r = $app->_readline_complete_options( $code, $text, $line,
	$start )
	and return $r;

    return $code->( $app, @arg );
}

# Calls to the following _formatter_complete_... methods are generated
# dynamically above, so there is no way Perl::Critic can find them.
# The Verb attribute must aggree with _helper_handler().

sub _formatter_complete_template : Verb( changes! raw! ) {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ( $app, undef, @arg ) = __arguments( @_ );
    my $fmtr = $app->get( 'formatter' );
    my $re = qr/ \A \Q$arg[2]\E /smx;
    return [
	grep { $_ =~ $re }
	sort( $fmtr->__list_templates() )
    ];
}

sub geocode : Verb( debug! ) {
    my ( $self, $opt, $loc ) = __arguments( @_ );

    my $set_loc;
    if ( defined $loc ) {
	$set_loc = 1;
    } else {
	$loc = $self->get( 'location' );
    }

    my $geocoder = $self->_helper_get_object( 'geocoder' );

    my @rslt = $geocoder->geocode( $loc );

    my $output;
    if ( @rslt == 1 ) {
	$set_loc
	    and $self->set( location => $rslt[0]{description} );
	$self->set( map { $_ => $rslt[0]{$_} } qw{ latitude
	    longitude } );
	$output .= $self->show(
	    ( $set_loc ? 'location' : () ), qw{latitude longitude} );
	if ( $self->get( 'autoheight' ) ) {
	    $opt->{geocoding} = 1;
	    $output .= $self->_height_us($opt);
	}
    } else {
	foreach my $poi ( @rslt ) {
	    $output .= join ' ', map { $poi->{$_} } qw{ latitude
	    longitude description };
	    $output =~ s/ (?: \A | (?
	}
    }
    return $output;
}

sub geodetic : Verb() {
    my ( $self, undef, $name, $lat, $lon, $alt ) = __arguments( @_ ); # $opt unused
    @_ == 5 or $self->wail( 'Want exactly four arguments' );
    my $body = Astro::Coord::ECI::TLE->new(
	name => $name,
	id => '',
	model => 'null',
    )->geodetic(
	deg2rad( $self->__parse_angle( $lat ) ),
	deg2rad( $self->__parse_angle( $lon ) ),
	$self->__parse_distance( $alt ),
    );
    push @{ $self->{bodies} }, $body;
    return;
}

sub get {
    my ($self, $name) = @_;
    $self->_attribute_exists( $name );
    $self->_deprecation_notice( attribute => $name );
    return $accessor{$name}->($self, $name);
}

sub height : Verb( debug! ) {
    return _height_us( __arguments( @_ ) );
}

sub _height_us {
    my ($self, $opt, @args) = @_;
    $self->_load_module ('Geo::WebService::Elevation::USGS');
    my $eq = Geo::WebService::Elevation::USGS->new(
	places => 2,	# Service returns unreasonable precision
	units => 'METERS',	# default for service is 'FEET'
	croak	=> 0,		# Handle our own errors
    );
    @args or push @args, $self->get('latitude'), $self->get('longitude');
    my $output;
    my ( $rslt ) = $eq->elevation(@args);
    if ( $eq->is_valid( $rslt ) ) {
	$self->set( height => $rslt->{Elevation} );
    } else {
	$opt->{geocoding}
	    or $self->wail( $eq->get( 'error' ) || 'No valid result found' );
	$self->set( height => 0 );
	$output .= "# Unable to obtain height. Setting to 0\n";
    }
    $output .= $self->show( 'height' );
    return $output;
}

sub help : Verb() {
    my ( $self, undef, $arg ) = __arguments( @_ );	# $opt unused
    defined $arg
	or $arg = '';
    defined $self->{_help_module}{$arg}
	and $arg = $self->{_help_module}{$arg};
    if ( my $cmd = $self->_get_browser_command() ) {
	my $kind = $arg =~ m/ - /smx ? 'release' : 'pod';
	$self->system( $cmd,
	    "https://metacpan.org/$kind/$arg" );
    } else {

	my $os_specific = "_help_$^O";
	if (__PACKAGE__->can ($os_specific)) {
	    return __PACKAGE__->$os_specific ();
	} elsif ( load_package( 'Pod::Usage' ) ) {
	    my @ha;
	    if ( defined( my $path = find_package_pod( $arg ) ) ) {
		push @ha, '-input' => $path;
	    }
	    my $stdout = $self->{frame}[-1]{localout};
	    if (openhandle $stdout && !-t $stdout) {
		push @ha, -output => $stdout;
	    }
	    Pod::Usage::pod2usage (
		-verbose => 2, -exitval => 'NOEXIT', @ha);
	} else {
	    # This should never happen, since Pod::Usage is core
	    # since 5.6. On the other hand we have not declared it
	    # as a dependency, and some downstream packagers seem to
	    # think they know more than the author what should be in
	    # a package.
	    return <<'EOD'
No help available; Pod::Usage can not be loaded.
EOD
	}
    }
    return;
}

# The call to this is generated dynamically above, and there is no way
# Perl::Critic can find it.
sub _help_MacOS {	## no critic (ProhibitUnusedPrivateSubroutines)
    return <<'EOD';

Normally, we would display the documentation for the satpass2
script here. But unfortunately this depends on the ability to
spawn the perldoc command, and we do not have this ability under
Mac OS 9 and earlier. You can find the same thing online at
https://metacpan.org/release/Astro-App-Satpass2

EOD
}

{
    # This hash specifies the specific grammar passed to
    # __infix_engine(). The keys are:
    # {done} optional; called when parse is complete.
    # {oper} defines operators. Values are hash refs with:
    #	{handler} code that handles operator;
    #	{validation} name of validation style (see {vld} below).
    # {vld} defines operator validation. There must be a key for each
    #	distinct value of {oper}{$name}{validation}.
    # NOTE WELL
    # Because if() has the Tweak( -unsatisfied ) attribute, any
    # operators that have side effects will need to be aware of whether
    # they are running inside an unsatisfied if().
    my %define = (
	done	=> sub {
	    # my ( $self, $def, $ctx, $tokens ) = @_;
	    my ( $self, undef, $ctx ) = @_;
	    @{ $ctx }
		and $self->wail( q );;
	    return;
	},
	oper	=> {
	    '('	=> {
		handler	=> sub {
		    my ( $self, $def, $ctx, $tokens ) = @_;
		    my $want = delete $ctx->[-1]{want};
		    defined $want
			or $want = 1;
		    push @{ $ctx }, {
			want	=> $want,
			value	=> [],
		    };
		    $ctx->[-2]{shortcut}
			and $ctx->[1]{shortcut} = $ctx->[-2]{shortcut};
		    my $depth = @{ $ctx };
		    while ( $depth <= @{ $ctx } ) {
			$self->_infix_engine_dispatch( $def, $ctx, $tokens );
		    }
		    return;
		},
	    },
	    ')'	=> {
		handler	=> sub {
		    # my ( $self, $def, $ctx, $tokens ) = @_;
		    my ( $self, undef, $ctx ) = @_;
		    @{ $ctx }
			or $self->wail( 'Unpaired right parentheses' );
		    $ctx->[-1]{want} == @{ $ctx->[-1]{value} }
			or $self->wail(
			"Expected $ctx->[-1]{want} value(s), got " .
			scalar @{ $ctx->[-1]{value} } );
		    push @{ $ctx->[-2]{value} }, @{ $ctx->[-1]{value} };
		    pop @{ $ctx };
		    return;
		},
	    },
	    '-n' => {
		handler => sub {
		    # my ( $self, $def, $ctx, $tokens ) = @_;
		    my ( undef, undef, $ctx, $tokens ) = @_;
		    my $v = shift @{ $tokens };
		    defined $v
			or $v = '';
		    push @{ $ctx->[-1]{value} }, '' ne $v;
		},
		validation	=> 'prefix',
	    },
	    '-z' => {
		handler => sub {
		    # my ( $self, $def, $ctx, $tokens ) = @_;
		    my ( undef, undef, $ctx, $tokens ) = @_;
		    my $v = shift @{ $tokens };
		    defined $v
			or $v = '';
		    push @{ $ctx->[-1]{value} }, '' eq $v;
		},
		validation	=> 'prefix',
	    },
	    and	=> {
		handler	=> sub {
		    my ( $self, $def, $ctx, $tokens ) = @_;
		    $ctx->[-1]{value}[-1]
			or $ctx->[-1]{shortcut} = 1;
		    $self->_infix_engine_dispatch( $def, $ctx, $tokens );
		    # For some reason the following has to be done in
		    # two statements, or both operands remain on the
		    # stack.
		    my $ro = pop @{ $ctx->[-1]{value} };
		    $ctx->[-1]{value}[-1] &&= $ro
			unless delete $ctx->[-1]{shortcut};
		    return;
		},
		validation	=> 'infix',
	    },
	    attr	=> {
		handler	=> sub {
		    # my ( $self, $def, $ctx, $tokens ) = @_;
		    my ( $self, undef, $ctx, $tokens ) = @_;
		    my $attr = shift @{ $tokens };
		    my $val;
		    $ctx->[-1]{shortcut}
			or $val = $self->_attribute_value( $attr );
		    NULL_REF eq ref $val
			and $self->wail( "No such attribute as '$attr'" );
		    push @{ $ctx->[-1]{value} }, $val;
		    return;
		},
		validation	=> 'prefix',
	    },
	    env	=> {
		handler	=> sub {
		    # my ( $self, $def, $ctx, $tokens ) = @_;
		    my ( undef, undef, $ctx, $tokens ) = @_;
		    my $name = shift @{ $tokens };
		    my $val;
		    $ctx->[-1]{shortcut}
			or $val = $ENV{$name};
		    push @{ $ctx->[-1]{value} }, $val;
		    return;
		},
		validation	=> 'prefix',
	    },
	    loaded	=> {
		handler	=> sub {
		    # my ( $self, $def, $ctx, $tokens ) = @_;
		    my ( $self, undef, $ctx, $tokens ) = @_;
		    my $name = shift @{ $tokens };
		    my @loaded;
		    $ctx->[-1]{shortcut}
			or @loaded = $self->__choose(
			{ bodies	=> 1 },
			[ $name ],
		    );
		    push @{ $ctx->[-1]{value} }, scalar @loaded;
		    return;
		},
		validation	=> 'prefix',
	    },
	    not	=> {
		handler	=> sub {
		    my ( $self, $def, $ctx, $tokens ) = @_;
		    $self->_infix_engine_dispatch( $def, $ctx, $tokens );
		    $ctx->[-1]{value}[-1] = ! $ctx->[-1]{value}[-1];
		    return;
		},
		validation	=> 'prefix',
	    },
	    or	=> {
		handler	=> sub {
		    my ( $self, $def, $ctx, $tokens ) = @_;
		    $ctx->[-1]{value}[-1]
			and $ctx->[-1]{shortcut} = 1;
		    $self->_infix_engine_dispatch( $def, $ctx, $tokens );
		    # For some reason the following has to be done in
		    # two statements, or both operands remain on the
		    # stack.
		    my $ro = pop @{ $ctx->[-1]{value} };
		    $ctx->[-1]{value}[-1] ||= $ro
			unless delete $ctx->[-1]{shortcut};
		    return;
		},
		validation	=> 'infix',
	    },
	    os	=> {
		handler	=> sub {
		    # my ( $self, $def, $ctx, $tokens ) = @_;
		    my ( undef, undef, $ctx, $tokens ) = @_;
		    my $re = qr< \A \Q$^O\E \z >smxi;
		    my $rslt = 0;
		    my $name = shift @{ $tokens };
		    unless ( $ctx->[-1]{shortcut} ) {
			foreach my $os ( split qr< [|] >smx, $name ) {
			    $os =~ $re
				or next;
			    $rslt = 1;
			    last;
			}
		    }
		    push @{ $ctx->[-1]{value} }, $rslt;
		    return;
		},
		validation	=> 'prefix',
	    },
	    then	=> {
		handler	=> sub {
		    # my ( $self, $def, $ctx, $tokens ) = @_;
		    my ( $self, undef, $ctx, $tokens ) = @_;
		    1 == @{ $ctx }
			or $self->wail( 'Unclosed left parentheses' );
		    my $last = pop @{ $ctx };
		    my @arg = splice @{ $tokens };
		    if ( $last->{dispatch} ) {
			$self->_dispatch_check( if => $arg[0] );
			$self->_frame_push( if => [], {
				condition	=> $last->{value}[-1],
			    },
			);
			$self->_add_post_dispatch( sub {
				$self->_frame_pop( if => undef );
			    },
			);
			return $self->dispatch( @arg );
		    } else {
			$self->_twiddle_condition( $last->{value}[-1] );
		    }
		},
		validation	=> 'terminal',
	    },
	},
	val	=> sub {
	    # my ( $self, $def, $ctx, $tkn, $tokens ) = @_;
	    my ( undef, undef, $ctx, $tkn ) = @_;
	    push @{ $ctx->[-1]{value} }, $tkn;
	    return;
	},
	vld	=> {
	    infix	=> sub {
		# my ( $self, $def, $ctx, $tkn, $tokens ) = @_;
		my ( $self, undef, $ctx, $tkn, $tokens ) = @_;
		@{ $ctx->[-1]{value} }
		    or $self->wail( "'$tkn' requires a left argument" );
		@{ $tokens }
		    or $self->wail( "'$tkn' requires a right argument" );
		return;
	    },
	    prefix	=> sub {
		# my ( $self, $def, $ctx, $tkn, $tokens ) = @_;
		my ( $self, undef, undef, $tkn, $tokens ) = @_;
		@{ $tokens }
		    or $self->wail( "'$tkn' requires an argument" );
		return;
	    },
	    terminal	=> sub {
		# my ( $self, $def, $ctx, $tkn, $tokens ) = @_;
		my ( $self, undef, $ctx, $tkn, $tokens ) = @_;
		@{ $ctx->[-1]{value} }
		    or $self->wail( "'$tkn' requires a left argument" );
		if ( $ctx->[-1]{dispatch} ) {
		    @{ $tokens }
			or $self->wail( "Command required after '$tkn'" );
		} else {
		    @{ $tokens }
			and $self->wail( "Command not allowed after '$tkn'" );
		}
		return;
	    }
	},
    );

    sub elsif : method Verb() Tweak( -unsatisfied ) {	## no critic (ProhibitBuiltInHomonyms)
	my ( $self, @args ) = @_;
	@args
	    or $self->wail( 'Arguments required' );

	@{ $self->{frame} } > 1
	    and 'begin' eq $self->{frame}[-1]{type}
	    and 'if' eq $self->{frame}[-2]{type}
	    or $self->wail( 'Elsif without if ... then begin' );

	my @ctx = ( {
		dispatch	=> 0,
		value	=> [],
	    } );

	# If any previous if() or elsif() evaluates true, we do not
	# evaluate subsequent elsif() calls.
	$self->{frame}[-2]{condition}
	    and return;
	return $self->__infix_engine( \%define, \@ctx, @args );
    }

    sub if : method Verb() Tweak( -unsatisfied ) {	## no critic (ProhibitBuiltInHomonyms)
	my ( $self, @args ) = @_;
	@args
	    or $self->wail( 'Arguments required' );
	my @ctx = ( {
		dispatch	=> 1,
		value	=> [],
	    } );
	return $self->__infix_engine( \%define, \@ctx, @args );
    }
}

sub init {
    my ( $self, @args ) = @_;

    my $opt = HASH_REF eq ref $args[0] ? shift @args : {};
    my $init_file = shift @args;

    $self->{initfile} = undef;

    foreach (
	defined $init_file ? (
	    sub {
		# A missing init file is only an error if it was
		# specified explicitly.
		-e $init_file
		    and not -d _
		    or $self->wail(
			"Initialization file $init_file not found, or is a directory"
		    );
		return ( $init_file, $opt->{level1} )
	    },
	) : (
	    sub { return $ENV{SATPASS2INI} },
	    sub { $self->initfile( { quiet => 1 } ) },
	    sub { return ( $ENV{SATPASSINI}, 1 ) },
	    \&_init_file_01,
	)
    ) {

	my ( $fn, $level1 ) = $_->($self);
	my $reader = $self->_file_reader( $fn, { optional => 1 } )
	    or next;
	$self->{initfile} = $fn;
	return $self->source( { level1 => $level1 }, $reader );

    }

    return;
}

sub initfile : Verb( create-directory! quiet! ) {
    my ( $self, $opt ) = __arguments( @_ );	# @args unused

    my $init_dir = my_dist_config(
	{ create => $opt->{'create-directory'} } );

    defined $init_dir
	or do {
	$opt->{quiet} and return;
	$self->wail(
	    'Init file directory not found' );
    };

    return File::Spec->catfile( $init_dir, 'satpass2rc' );
}

sub _in_unsatisfied_if {
    my ( $self ) = @_;
    return @{ $self->{frame} } ? $self->{frame}[-1]{unsatisfied_if} : 0;
}

# This is a generalized infix expression engine. It does not implement
# operator precedence and is therefore very small. The arguments are:
#   - $self is the invocant, which must be an
#     Astro::App::Satpass2::Copier.
#   - $def is the hash that defines the grammar. This provides the
#     following keys:
#     {done} is an optional code reference. If present, the code
#	 reference is called once the parse is complete, and passed
#	 ( $self, $def, $ctx, \@tokens ). It returns nothing. The intent
#	 is to throw an exception if the parse is incomplete.
#     {oper} defines the operators. This is a hash keyed by the literal
#        operator (i.e. '+' to implement a '+' operator), and having the
#        following values:
#        {handler} is a required code reference, which implements the
#           operator. It is passed ( $self, $def, $ctx, \@tokens ). The
#           @tokens do not include the operator itself.
#        {validation} is an optional validation specification. If
#           present it is a key in the {vld} (see below).
#     {val} is an optional code reference. If present, it is called if a
#        token is not recognized as an operator, and passed ( $self,
#        $def, $ctx, \@tokens ). The @tokens include the unrecognized
#        token, which is presumed to be a value, and must be removed
#        from @tokens.
#     {vld} is a hash of validators. The keys are values in the
#        {validation} key documented under {oper} (above), and the
#        values are code references which are called with ( $self, $ctx,
#        $tkn, \@tokens ) where $tkn is the token being validated, and
#        @tokens is the rest of the tokens. This hash must exist if the
#        {validation} key is used in {oper}; otherwise it is optional.
#   - $ctx is context for the operations. It is not used by the engine
#     itself, but the individual operator code will need to use it as
#     context for the parse.  See if() for an example.
#   - @tokens are the tokens to be evaluated by the engine.
sub __infix_engine {
    my ( $self, $def, $ctx, @tokens ) = @_;
    @tokens
	or $self->wail( 'Nothing to compute' );
    my $rslt;
    while ( @tokens ) {
	$rslt = $self->_infix_engine_dispatch( $def, $ctx, \@tokens );
    }
    $def->{done}
	and $def->{done}->( $self, $def, $ctx, \@tokens );
    return $rslt;
}

sub _infix_engine_dispatch {
    my ( $self, $def, $ctx, $tokens ) = @_;
    @{ $tokens }
	or return;
    my $tkn = shift @{ $tokens };
    if ( my $info = $def->{oper}{$tkn} ) {
	$info->{validation}
	    and $def->{vld}{ $info->{validation} }->(
	    $self, $def, $ctx, $tkn, $tokens );
	return $info->{handler}->( $self, $def, $ctx, $tokens );
    } elsif ( $def->{val} ) {
	return $def->{val}->( $self, $def, $ctx, $tkn, $tokens );
    } else {
	$self->wail( "Unrecognized token '$tkn'" );
    }
    return;	# We can't get here, but Perl::Critic does not know this.
}

#	$file_name = _init_file_01()
#
#	This subroutine returns the first alternate init file name,
#	which is the standard name for the Astro-satpass 'satpass'
#	script. If called in list context it returns not only the name,
#	but a 1 to tell the caller this is a 'level1' file.

sub _init_file_01 {
    my $inifn = $^O eq 'MSWin32' || $^O eq 'VMS' || $^O eq 'MacOS' ?
	'satpass.ini' : '.satpass';
    my $inifile = $^O eq 'VMS' ? "SYS\$LOGIN:$inifn" :
	$^O eq 'MacOS' ? $inifn :
	$ENV{HOME} ? "$ENV{HOME}/$inifn" :
	$ENV{LOGDIR} ? "$ENV{LOGDIR}/$inifn" :
	$ENV{USERPROFILE} ? "$ENV{USERPROFILE}" : undef;
    return wantarray ? ( $inifile, 1 ) : $inifile;
}

sub list : Verb( choose=s@ ) {
    my ( $self, $opt, @args ) = __arguments( @_ );

    @args
	and not $opt->{choose}
	and $opt->{choose} = \@args;
    my @bodies = $self->__choose( $opt->{choose}, $self->{bodies} );

    @bodies
	and return $self->__format_data(
	    list => \@bodies, $opt );

    $self->{warn_on_empty}
	and $self->whinge( 'The observing list is empty' );

    return;
}

sub load : Verb( verbose! ) {
    my ( $self, $opt, @names ) = __arguments( @_ );
    @names or $self->wail( 'No file names specified' );

    my $attrs = {
	illum	=> $self->get( 'illum' ),
	model	=> $self->get( 'model' ),
	sun	=> $self->_sky_object( 'sun' ),
    };

    foreach my $fn ( @names ) {
	$opt->{verbose} and warn "Loading $fn\n";
	my $data = $self->_file_reader( $fn, { glob => 1 } );
	$self->__add_to_observing_list(
	    Astro::Coord::ECI::TLE->parse( $attrs, $data ) );
    }
    return;
}

sub localize : Verb( all|except! ) {
    my ( $self, $opt, @args ) = __arguments( @_ );

    foreach my $name ( @args ) {
	$self->_attribute_exists( $name );
    }

    if ( $opt->{all} ) {
	my %except = map { $_ => 1 } @args;
	@args = grep { ! $except{$_} } sort keys %mutator;
    }

    foreach my $name ( @args ) {
	$self->_localize( $name );
    }

    return;
}

sub _localize {
    my ( $self, $key ) = @_;

    my $val = exists $self->{$key} ?
	$self->{$key} :
	$self->get( $key );
    my $clone = ( blessed( $val ) && $val->can( 'clone' ) ) ?
	$val->clone() :
	ref $val ? Clone::clone( $val ) : $val;

    $self->{frame}[-1]{local}{$key} = $val;
    if ( exists $self->{$key} ) {
	$self->{$key} = $clone;
    } else {
	$self->set( $key => $clone );
    }

    return;
}

sub location : Verb( dump! ) {
    my ( $self, $opt ) = __arguments( @_ );
    return $self->__format_data(
	location => $self->station(), $opt );
}

{

    # TODO the %mac_cmd hash is only needed for level1 compatibility.
    # Once that goes away, it can too PROVIDED we also drop the
    # subcommand defaulting functionality.
    # Subcommand defaulting dropped 2021-09-20 unless explicitly level1,
    # after I discovered that my init file defined an unwanted macro
    # when I mistyped 'define' as 'defined'.
    my %mac_cmd;
    {
	my $stb = __PACKAGE__ . '::';
	my @cmdnam;
	{
	    no strict qw{ refs };
	    foreach my $entry ( keys %{ $stb } ) {
		$entry =~ m/ \A _macro_sub_ ( \w+ ) /smx
		    or next;
		# Strictly speaking I should make sure the {CODE} slot
		# is occupied here.
		push @cmdnam, $1;
	    }
	}
	my %abbr = abbrev(@cmdnam);
	foreach (keys %abbr) {
	    $mac_cmd{'-' . $_} = $abbr{$_};
	}
	foreach (@cmdnam) {
	    $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} = {
	pass_ics	=> 1,
    }->{$opt->{_template}};

    $self->_apply_boolean_default(
	$opt, 0, qw{ horizon illumination transit appulse } );
    $self->_apply_boolean_default( $opt, 0, qw{ am pm } );
    $opt->{am} or $opt->{pm} or $opt->{am} = $opt->{pm} = 1;
    my $pass_start = $self->__parse_time (
	shift @args, $self->_get_day_noon());
    my $pass_end = $self->__parse_time (shift @args || '+7');
    $pass_start >= $pass_end
	and $self->wail( 'End time must be after start time' );

    my $sta = $self->station();
    my @bodies = $self->__choose( $opt->{choose}, $self->{bodies} )
	or $self->wail( 'No bodies selected' );
    my $pass_step = shift @args || 60;

#	Decide which model to use.

    my $model = $self->{model};

    # Set the station for the objects in the sky.

    foreach my $body ( @{ $self->{sky} } ) {
	$body->set( station => $sta );
    }

#	Pick up horizon and appulse distance.

    my $horizon = deg2rad ($self->{horizon});
    my $appulse = deg2rad ($self->{appulse});
    my $pass_threshold = deg2rad( $self->{pass_threshold} );

    # In order that the interface not be completely rude, the interface
    # allows -brightest to specify that you want the 'brightest' event.
    # But this is controlled by the pass_variant attribute. So if
    # -brightest appears, the pass_variant from it; otherwise we default
    # -brightest from the pass_variant attribute.  We localize the
    # pass_variant attribute before modifying it, since the -brightest
    # option is to hold for this call only. We modify it (rather than
    # just passing a local copy to the bodies) because
    # Formatter::Template needs to know what it is, and modifying this
    # object is the obvious way to pass the information.
    local $self->{pass_variant} = $self->{pass_variant};
    if ( $opt->{brightest} ) {
	$self->{pass_variant} |= PASS_VARIANT_BRIGHTEST;
    } elsif ( exists $opt->{brightest} ) {
	$self->{pass_variant} &= ~ PASS_VARIANT_BRIGHTEST;
    } else {
	$opt->{brightest} = $self->{pass_variant} & PASS_VARIANT_BRIGHTEST;
    }
    my $pass_variant = $self->{pass_variant};

#	Foreach body to be modelled

    my @accumulate;	# For chronological output.
    foreach my $tle ( $self->_aggregate( \@bodies ) ) {

	{
	    my $mdl = $tle->get('inertial') ? $model :
		$tle->get('model');
	    $tle->set (
		appulse => $appulse,
		backdate => $self->{backdate},
		debug => $self->{debug},
		edge_of_earths_shadow => $self->{edge_of_earths_shadow},
		geometric => $self->{geometric},
		horizon => $horizon,
		interval => ( $self->{verbose} ? $pass_step : 0 ),
		model => $mdl,
		pass_threshold => $pass_threshold,
		pass_variant	=> $pass_variant,
		station	=> $sta,
		twilight => $self->{_twilight},
		visible => $self->{visible},
	    );
	}

	eval {
	    push @accumulate, $self->_pass_select_event( $opt, $tle->pass (
		$pass_start, $pass_end, $self->{sky} ) );
	    1;
	} or do {
	    $@ =~ m/ \Q$interrupted\E /smxo and $self->wail($@);
	    $opt->{quiet} or $self->whinge($@);
	};
    }

    @accumulate = $self->__pass_filter_am_pm( $opt, @accumulate );

    $opt->{chronological}
	and @accumulate = sort { $a->{time} <=> $b->{time} }
	    @accumulate;

    # Record number of events found.
    # NOTE that in this case an event is an entire pass.

    $self->{events} += @accumulate;

    if ( $opt->{almanac} ) {
	my %almanac;
	foreach my $pass ( @accumulate ) {
	    my $illum = $pass->{body}->get( 'illum' );
	    my $noon = $self->_get_day_noon( $pass->{time} );
	    $almanac{$noon}{$illum} ||= do {
		my @day;

		my @events = grep { {
			horizon		=> 1,
			twilight	=> 1,
		    }->{$_->{almanac}{event}}
		} $illum->almanac_hash(
		    $self->_get_day_midnight( $pass->{time} ) );

		_almanac_localize( @events );

		foreach my $evt ( @events ) {
		    $evt->{event} = 'almanac';
		    my $pm = $evt->{time} >= $noon ? 1 : 0;
		    push @{ $day[$pm] }, $evt;
		}

		\@day;
	    };

	    $pass->{_pm} = my $pm = $pass->{time} >= $noon ? 1 : 0;
	    # TODO this way ALL passes get the almanac events. Is this
	    # what I want? It varies. For --ics it is. For --events it
	    # is not. For neither it's probably not.
	    if ( $opt->{ephemeris} ) {
		@{ $pass->{events} } = sort { $a->{time} <=> $b->{time}
		    } @{ $pass->{events} }, @{ $almanac{$noon}{$illum}[$pm] };
	    }
	}

	unless( $opt->{ephemeris} ) {
	    foreach my $pass ( @accumulate ) {
		$pass->{_pm}
		    or next;
		my $illum = $pass->{body}->get( 'illum' );
		my $noon = $self->_get_day_noon( $pass->{time} );
		$almanac{$noon}{$illum}[1]
		    or next;
		@{ $pass->{events} } = sort { $a->{time} <=> $b->{time} }
		    @{ $pass->{events} },
		    @{ $almanac{$noon}{$illum}[1] };
		$almanac{$noon}{$illum}[1] = undef;
	    }
	    foreach my $pass ( reverse @accumulate ) {
		$pass->{_pm}
		    and next;
		my $illum = $pass->{body}->get( 'illum' );
		my $noon = $self->_get_day_noon( $pass->{time} );
		$almanac{$noon}{$illum}[0]
		    or next;
		@{ $pass->{events} } = sort { $a->{time} <=> $b->{time} }
		    @{ $pass->{events} },
		    @{ $almanac{$noon}{$illum}[0] };
		$almanac{$noon}{$illum}[0] = undef;
	    }
	}
    }

    return $self->__format_data(
	$opt->{_template} => \@accumulate, $opt );

}

sub __pass_filter_am_pm {
    my ( $self, $opt, @accumulate ) = @_;
    $opt ||= {};
    $opt->{am} xor $opt->{pm}
	or return @accumulate;
    return (
	map { $_->[0] }
	grep { $opt->{am} xor $_->[1] }
	map { [
	    $_,
	    $_->{time} >= $self->_get_day_noon( $_->{time} )
	    ] } @accumulate
    );
}

sub __pass_options {
    my ( $self, $opt ) = @_;
    return [
	qw{
	    almanac! am! appulse! brightest|magnitude! choose=s@
	    chronological! ephemeris! dump! horizon|rise|set!
	    illumination! pm!
	    quiet! transit|maximum|culmination!
	},
	$self->_templates_to_options( pass => $opt ),
    ];
}

{
    my @selector;
    $selector[ PASS_EVENT_SHADOWED ]	= 'illumination';
    $selector[ PASS_EVENT_LIT ]		= 'illumination';
    $selector[ PASS_EVENT_DAY ]		= 'illumination';
    $selector[ PASS_EVENT_RISE ]	= 'horizon';
    $selector[ PASS_EVENT_MAX ]		= 'transit';
    $selector[ PASS_EVENT_SET ]		= 'horizon';
    $selector[ PASS_EVENT_APPULSE ]	= 'appulse';
    $selector[ PASS_EVENT_START ]	= 'horizon';
    $selector[ PASS_EVENT_END ]		= 'horizon';
    $selector[ PASS_EVENT_BRIGHTEST ]	= 'brightest';

    # Remove from the pass data any events that are not wanted. The
    # arguments are $self, the $opt hash reference that (among other
    # things) specifies the desired events, and the passes, each pass
    # being an argument. The modified passes are returned.
    sub _pass_select_event {
	my ( undef, $opt, @passes ) = @_;	# Invocant unused
	my @rslt;
	foreach my $pass ( @passes ) {
	    @{ $pass->{events} } = grep {
		_pass_select_event_code( $opt, $_->{event} )
		} @{ $pass->{events} }
		and push @rslt, $pass;
	}
	return @rslt
    }

    # Determine whether an event is to be reported for the pass. The
    # arguments are the $opt hash reference and the event code or name.
    # Anything that is not a dualvar and not an integer is accepted, on
    # the presumption that it is an ad-hoc event provided by some
    # subclass. The null event is always accepted on the presumption
    # that if the user did not want it he or she would not have asked
    # for it. Anything that is left is accepted or rejected based on the
    # option hash and the @selector array (defined above).
    sub _pass_select_event_code {
	my ( $opt, $event ) = @_;
	isdual( $event )
	    or $event !~ m/ \D /smx
	    or return 1;
	$event == PASS_EVENT_NONE
	    and return 1;
	return defined $selector[ $event ] && $opt->{ $selector[ $event ] };
    }
}

sub perl : Tokenize( -noexpand_tilde ) : Verb( eval! setup! ) {
    my ( $self, $opt, $file, @args ) = __arguments( @_ );
    defined $file
	or $self->wail( 'At least one argument is required' );
    $opt->{setup}
	and push @{ $self->{_perl} ||= [] }, [ $opt, $file, @args ];
    local @ARGV = ( $self, map { $self->expand_tilde( $_ ) } @args );
    $opt->{eval}
	or local $0 = $self->expand_tilde( $file );

    my $data = $opt->{eval} ?
	$file :
	$self->_file_reader( $file, { glob => 1 } );
    my $rslt;
    {
	# "random" package to prevent whoopsies in our own name space
	package qq_eval_namespace; ## no critic (Modules::ProhibitMultiplePackages)
	$rslt = eval $data; ## no critic (BuiltinFunctions::ProhibitStringyEval)
	$@
	    and $self->wail( "Failed to eval '$file': $@" );
    }
    instance( $rslt, 'Astro::App::Satpass2' )
	or return $rslt;
    return;
}

sub phase : Verb( choose=s@ ) {
    my ( $self, $opt, @args ) = __arguments( @_ );

    my $time = $self->__parse_time (shift @args, time );

    my @sky = $self->__choose( $opt->{choose}, $self->{sky} )
	or $self->wail( 'No bodies selected' );
    return $self->__format_data(
	phase => [
	    map { { body => $_->universal( $time ), time => $time } }
	    grep { $_->can( 'phase' ) }
	    @sky
	], $opt );
}

sub position : Verb( choose=s@ questionable|spare! quiet! ) {
    my ( $self, $opt, $time ) = __arguments( @_ );

    if ( defined $time ) {
	$time = $self->__parse_time($time);
    } else {
	$time = time;
    }

#	Define the observing station.

    my $sta = $self->station();
    $sta->universal( $time );

    my @list = $self->__choose( { bodies => 1, sky => 1 },
	$opt->{choose} );

    my @good;
    my $horizon = deg2rad ($self->{horizon});
    foreach my $body (@list) {
	if ( $body->represents( 'Astro::Coord::ECI::TLE' ) ) {
	    $body->set (
		backdate => $self->{backdate},
		debug => $self->{debug},
		edge_of_earths_shadow => $self->{edge_of_earths_shadow},
		geometric => $self->{geometric},
		horizon => $horizon,
		station	=> $sta,
		twilight => $self->{_twilight},
	    );
	    $body->get('inertial')
		and $body->set( model => $self->{model} );
	}
	eval {
	    $body->universal ($time);
	    push @good, $body;
	    1;
	} or do {
	    $@ =~ m/ \Q$interrupted\E /smxo and $self->wail($@);
	    $opt->{quiet} or $self->whinge($@);
	};
    }

    return $self->__format_data(
	position => {
	    bodies		=> \@good,
	    questionable	=> $opt->{questionable},
	    station		=> $self->station()->universal(
		$time ),
	    time		=> $time,
	    twilight		=> $self->{_twilight},
	}, $opt );
}

sub pwd : Verb() {
    return Cwd::cwd() . "\n";
}

{
    my @quarter_name = map { "q$_" } 0 .. 3;

    sub quarters : Verb( choose=s@ dump! q0|new|spring! q1|first|summer!  q2|full|fall q3|last|winter ) {
	my ( $self, $opt, @args ) = __arguments( @_ );

	my $start = $self->__parse_time (
	    $args[0], $self->_get_day_midnight() );
	my $end = $self->__parse_time ($args[1] || '+30');

	$self->_apply_boolean_default( $opt, 0, map { "q$_" } 0 .. 3 );

	my @sky = $self->__choose( $opt->{choose}, $self->{sky} )
	    or $self->wail( 'No bodies selected' );

	my @almanac;

	# Iterate over any background objects, accumulating all
	# quarter-phases of each until we get one after the end time. We
	# silently ignore bodies that do not support the next_quarter()
	# method.

	foreach my $body ( @sky ) {
	    next unless $body->can ('next_quarter_hash');
	    $body->universal ($start);

	    while (1) {
		my $hash = $body->next_quarter_hash();
		$hash->{time} > $end and last;
		$opt->{$quarter_name[$hash->{almanac}{detail}]}
		    or next;
		push @almanac, $hash;
	    }
	}

	# Localize the event descriptions if appropriate.

	foreach my $event ( @almanac ) {
	    $event->{almanac}{description} = __localize(
		text	=> [ almanac => $event->{body}->get( 'name' ),
		    $event->{almanac}{event}, $event->{almanac}{detail}
		],
		default	=> $event->{almanac}{description},
		argument	=> $event->{body},
	    );
	}

	# Record number of events found

	$self->{events} += @almanac;

	# Sort and display the quarter-phase information.

	return $self->__format_data(
	    almanac => [
		sort { $a->{time} <=> $b->{time} }
		@almanac
	    ], $opt );

    }
}

{
    my $go;

    sub run {
	my ( $self, @args ) = @_;

	# We can be called statically. If we are, instantiate.
	ref $self or $self = $self->new(warning => 1);

	# Put all the I/O into UTF-8 mode.
	binmode STDIN, ':encoding(UTF-8)';
	binmode STDOUT, DEFAULT_STDOUT_LAYERS;
	binmode STDERR, ':encoding(UTF-8)';

	# If the undocumented first option is a code reference, use it to
	# get input.
	my $in;
	CODE_REF eq ref $args[0]
	    and $in = shift @args;

	# Parse the command options. -level1 is undocumented.
	my %opt;
	$go ||= Getopt::Long::Parser->new();
	$go->getoptionsfromarray(
	    \@args,
	    \%opt,
	    qw{
		echo! filter! gmt! help initialization_file|initfile=s
		level1! version
	    },
	)
	    or $self->wail( 'See the help method for valid options' );

	# If -version, do it and return.
	if ( $opt{version} ) {
	    print $self->version();
	    return;
	}

	# If -help, do it and return.
	if ( $opt{help} ) {
	    $self->help();
	    return;
	}

	# Get an input routine if we do not already have one.
	$in ||= $self->_get_readline();

	# Some options get processed before we initialize.
	foreach my $name ( qw{ echo filter } ) {
	    exists $opt{$name}
		and $self->set( $name => delete( $opt{$name} ) );
	}

	# Display the front matter if desired.
	(!$self->get('filter') && $self->_get_interactive())
	    and print $self->version();

	# Execute the initialization file.
	eval {
	    $self->_execute_output( $self->init(
		    { level1 => delete $opt{level1} },
		    delete $opt{initialization_file},
		), $self->get( 'stdout' ) );
	    1;
	} or warn $@;	# Not whinge, since presumably we already did.

	# The remaining options set the corresponding attributes.
	%opt and $self->set(%opt);

	# Execution loop. What exit() really does is a last on this.
    SATPASS2_EXECUTE:
	{
	    $self->_execute( @args );
	    while ( defined ( my $buffer = $in->( $self->get( 'prompt' ) ) ) ) {
		$self->_execute( $in, $buffer );
	    }
	}
	$self->_execute( q{echo ''} );	# The lazy way to be sure we
					    # have a newline before exit.
	return;
    }
}

sub save : Verb( changes! overwrite! ) {
    my ( $self, $opt, $fn ) = __arguments( @_ );

    defined $fn or $fn = $self->initfile( { 'create-directory' => 1 } );
    chomp $fn;	# because initfile() adds a newline for printing
    if ($fn ne '-' && -e $fn) {
	-f $fn or $self->wail(
	    "Can not overwrite $fn: not an ordinary file");
	$opt->{overwrite} or do {
	    my $rslt = $self->_get_readline()->(
		"File $fn exists. Overwrite [y/N]? ");
	    'y' eq lc substr($rslt, 0, 1)
		or return;
	};
    }
    my @show_opt;
    my $title = 'settings';
    if ($opt->{changes}) {
	push @show_opt, '-changes';
	$title = 'setting changes';
    }

    my $output = <<"EOD" .

# Astro::App::Satpass2 $title

EOD
	$self->show( @show_opt, qw{ -nodeprecated -noreadonly } ) .
	<<"EOD" . $self->macro('list');

# Astro::App::Satpass2 macros

EOD

    if ( $self->{_perl} ) {
	$output .= <<'EOD';

# Astro::App::Satpass2 setup

EOD
	foreach my $item ( @{ $self->{_perl} } ) {
	    my ( $opt, @arg ) = @{ $item };
	    my @cmd = ( 'perl' );
	    push @cmd, map { "-$_" } grep { $opt->{$_} } sort keys %{ $opt };
	    $output .= join ' ', quoter( @cmd, @arg );
	    $output .= "\n";
	}
    }

    foreach my $attribute ( qw{ formatter spacetrack time_parser } ) {
	my $obj = $self->get( $attribute ) or next;
	my $class = $obj->can( 'class_name_of_record' ) ?
	    $obj->class_name_of_record() :
	    ref $obj || $obj;
	$output .= <<"EOD" .

# $class $title

EOD
	( $self->$attribute( $opt, 'config' ) || "# none\n" );
    }

    $output .= $self->_save_sky( $opt );

    if ($fn ne '-') {
	my $fh = IO::File->new( $fn, '>:encoding(utf-8)')
	    or $self->wail("Unable to open $fn: $!");
	print { $fh } $output;
	$output = "$fn\n";
    }
    return $output;
}

# Formats the commands to reconstitute the sky. This is only called from
# save(), but it is a subroutine for organizational reasons.
sub _save_sky {
    my ( $self, $opt ) = @_;

    my $output = <<'EOD';

# Astro::App::Satpass2 sky

EOD

    foreach my $body ( sort keys %{ $self->{sky_class} } ) {
	$opt->{changes}
	    and $sky_class{$body}
	    and $sky_class{$body} eq $self->{sky_class}{$body}
	    and next;
	$output .= $self->_sky_class_components( $body ) . "\n";
    }
    foreach my $body ( sort keys ( %sky_class ) ) {
	$self->{sky_class}{$body}
	    or $output .= $self->_sky_class_components( $body ) . "\n";
    }

    my %exclude;
    if ( $opt->{changes} ) {
	%exclude = map { $_ => 1 }
	    SUN_CLASS_DEFAULT, 'Astro::Coord::ECI::Moon';
	foreach my $name ( qw{ sun moon } ) {
	    defined $self->_find_in_sky( $name )
		or $output .= "sky drop $name\n";
	}
    } else {
	$output .= "sky clear\n";
    }
    foreach my $body ( @{ $self->{sky} } ) {
	$exclude{ ref $body }
	    and next;
	$output .= _sky_list_body( $body );
    }

    return $output;
}

sub set : Verb() {
    my ( $self, undef, @args ) = __arguments( @_ );	# $opt unused

    while (@args) {
	my ( $name, $value ) = splice @args, 0, 2;
	$self->_attribute_exists( $name );
	if ( _is_interactive() ) {
	    $nointeractive{$name}
		and $self->wail(
		    "Attribute '$name' may not be set interactively");
	    defined $value and $value eq 'undef'
		and $value = undef;
	}
	if ( $mutator{$name} ) {
	    $self->_deprecation_notice( attribute => $name );
	    $mutator{$name}->($self, $name, $value);
	} else {
	    $self->wail("Read-only attribute '$name'");
	}
    }
    return;
}

sub _set_almanac_horizon {
    my ( $self, $name, $value ) = @_;
    my $parsed = $self->__parse_angle( { accept => 1 }, $value );
    my $internal = looks_like_number( $parsed ) ? deg2rad( $parsed ) :
	$parsed;
    my $eci = Astro::Coord::ECI->new();
    $eci->set( $name => $internal );	# To validate.
    $self->{"_$name"} = $internal;
    return( $self->{$name} = $parsed );
}

{
    my $plus_or_minus_90 = sub { $_[0] >= -90 && $_[0] <= 90 };
    my %validate = (
	horizon		=> $plus_or_minus_90,
	latitude	=> $plus_or_minus_90,
	longitude	=> sub {
	    $_[0] > 360
		and return 0;
	    $_[0] > 180
		and $_[0] -= 360;
	    $_[0] >= -180 && $_[0] <= 180;
	},
    );
    sub _set_angle {
	my ( $self, $name, $value ) = @_;
	my $angle = $self->__parse_angle( $value );
	if ( my $code = $validate{$name} ) {
	    defined $angle or $self->weep(
		"$name angle is undef for value ", defined $value ? $value : 'undef' );
	    $code->( $angle )
		or $self->wail( "Value $value is invalid for $name" );
	}
	$self->{"_$name"} = deg2rad( $angle );
	return ( $self->{$name} = $angle );
    }
}

sub _set_angle_or_undef {
    my ( $self, $name, $value ) = @_;
    defined $value and 'undef' ne $value and goto &_set_angle;
    return ( $self->{$name} = undef );
}

sub _set_code_ref {
    CODE_REF eq ref $_[2]
	or $_[0]->wail( "Attribute $_[1] must be a code reference" );
    return( $_[0]{$_[1]} = $_[2] );
}

# Set an attribute whose value is an Astro::App::Satpass2::Copier object
# %arg is a hash of argument name/value pairs:
#    {name} is the required name of the attribute to set;
#    {value} is the required value of the attribute to set;
#    {class} is the optional class that the object must be;
#    {default} is the optional default value if the required value is
#        undef or '';
#    {undefined} is an optional value which, if true, permits the
#        attribute to be set to undef;
#    {nocopy} is an optional value which, if true, causes the old
#        object's attributes not to be copied to the new object;
#    {message} is an optional message to emit if the object can not be
#	instantiated;
#    {prefix} is an optional reference to an array of name prefixes to
#	try if the named module does not load.

sub _set_copyable {
    my ( $self, %arg ) = @_;
    my $old = $self->{$arg{name}};
    my $obj;
    if ( ref $arg{value} ) {
	blessed( $arg{value} )
	    or $self->wail( "$arg{name} may not be unblessed reference" );
	$obj = $arg{value};
	$obj->can( 'warner' )
	    and $obj->warner( $self->{_warner} );
    } else {
	if ( defined $arg{default} ) {
	    defined $arg{value}
		and '' ne $arg{value}
		or $arg{value} = $arg{default};
	}
	if ( ! defined $arg{value} || $arg{value} eq '' ) {
	    $arg{undefined}
		or $self->wail(
		"$arg{name} must be defined and not empty",
	    );
	    return ( $self->{$arg{name}} = $arg{value} = undef );
	}
	my ( $pkg, @args ) = $self->__parse_class_and_args( $arg{value} );
	my $cls = $self->load_package(
	    { fatal => 'wail' }, $pkg, @{ $arg{prefix} || [] } );
	not $cls->can( 'init' )
	    and _is_case_tolerant()
	    and $self->wail(
	    "$cls is missing methods. This can happen on a ",
	    'case-tolerant system if you specify the class ',
	    'name in the wrong case.' );
	$cls->can( 'parent' )
	    and push @args, parent => $self;
	$obj = $cls->new(
	    warner	=> $self->{_warner},
	    @args,
	)
	    or $self->wail( $arg{message} ||
	    "Can not instantiate object from '$arg{value}'" );
    }
    defined $arg{class}
	and not $obj->isa( $arg{class} )
	and $self->wail( "$arg{name} must be of class $arg{class}" );
    blessed( $old )
	and not $arg{nocopy}
	and $old->can( 'copy' )
	and $old->copy( $obj );
    $self->{$arg{name}} = $obj;
    return $arg{value};
}

sub _set_distance_meters {
    return ( $_[0]{$_[1]} = defined $_[2] ?
	( $_[0]->__parse_distance( $_[2], '0m' ) * 1000 ) : $_[2] );
}

sub _set_ellipsoid {
    my ($self, $name, $val) = @_;
    Astro::Coord::ECI->set (ellipsoid => $val);
    return ($self->{$name} = $val);
}

sub _set_formatter {
    my ( $self, $name, $val ) = @_;
    return $self->_set_copyable(
	name	=> $name,
	value	=> $val,
	message	=> 'Unknown formatter',
	default	=> 'Astro::App::Satpass2::Format::Template',
	prefix	=> [ 'Astro::App::Satpass2::Format' ]
    );
}

sub _set_formatter_attribute {
    my ( $self, $name, $val ) = @_;
    $self->get( 'formatter' )->$name( $val );
    return $val;
}

sub _set_geocoder {
    my ( $self, $name, $val ) = @_;
    return $self->_set_copyable(
	name	=> $name,
	value	=> $val,
	class	=> 'Astro::App::Satpass2::Geocode',
	message	=> 'Unknown formatter',
	default	=> $default_geocoder->(),
	undefined => 1,
	nocopy	=> 1,
	prefix	=> [ 'Astro::App::Satpass2::Geocode' ]
    );
}

sub _set_illum_class {
    my ( $self, $name, $class ) = @_;
    my $want_class = 'Astro::Coord::ECI';
    ref $class and $self->wail( "$name must not be a reference" );
    if ( defined $class ) {
	$self->load_package( { fatal => 'wail' }, $class );
	$class->isa( $want_class )
	    or $self->wail( "$name must be an $want_class" );
    } else {
	$class = $want_class;
    }
    $self->{$name} = $class;
    $self->{_help_module}{$name} = $class;
    foreach my $body ( @{ $self->{bodies} } ) {
	$body->set( $name => $class );
    }
    return;
}

sub _set_model {
    my ( $self, $name, $val ) = @_;
    Astro::Coord::ECI::TLE->is_valid_model( $val )
	or $self->wail(
	"'$val' is not a valid Astro::Coord::ECI::TLE model" );
    foreach my $body ( @{ $self->{bodies} } ) {
	$body->set( model => $val );
    }
    return ( $self->{$name} = $val );
}

sub _set_output_layers {
    my ( $self, $name, $val ) = @_;

    if ( defined $val && '' ne $val ) {
	open my $fh, ">$val", File::Spec->devnull()
	    or $self->wail( "Invalid $name value '$val'" );
	close $fh;
    }
    return ( $self->{$name} = $val );
}

{
    my %variant_def = (
	visible_events	=> PASS_VARIANT_VISIBLE_EVENTS,
	fake_max	=> PASS_VARIANT_FAKE_MAX,
	start_end	=> PASS_VARIANT_START_END,
	no_illumination	=> PASS_VARIANT_NO_ILLUMINATION,
	brightest	=> PASS_VARIANT_BRIGHTEST,
    );

    my @option_names;
    foreach my $key ( keys %variant_def ) {
	if ( $key =~ m/ _ /smx ) {
	    ( my $dashed = $key ) =~ s/ _ /-/smxg;
	    $key = "$key|$dashed";
	}
	push @option_names, "$key!";
    }

    my $go;

    sub _set_pass_variant {
	my ( $self, $name, $val ) = @_;
	if ( $val =~ m/ \A (?: 0 x? ) [0-9]* \z /smx ) {
	    $val = oct $val;
	} elsif ( $val !~ m/ \A [0-9]+ \z /smx ) {
	    my @args = split qr{ [^\w-] }smx, $val;
	    foreach ( @args ) {
		s/ \A (?! - ) /-/smx;
	    }
	    $go ||= Getopt::Long::Parser->new();
	    $val = $self->get( $name );
	    $go->getoptionsfromarray( \@args,
		none	=> sub { $val = PASS_VARIANT_NONE },
		map { $_ => sub {
			my ( $name, $value ) = @_;
			my $mask = $variant_def{$name};
			if ( $value ) {
			    $val |= $mask;
			} else {
			    $val &= ~ $mask;
			}
			return;
		    }
		} @option_names )
		or $self->wail( "Invalid $name value '$val'" );
	}
	return ( $self->{$name} = $val );
    }

    sub _show_pass_variant {
	my ( $self, $name ) = @_;
	my $val = $self->get( $name );
	my @options;
	foreach my $key ( keys %variant_def ) {
	    $val & $variant_def{$key}
		and push @options, "$key";
	}
	@options
	    or push @options, 'none';
	return ( set => $name, join ',', @options );
    }

    sub want_pass_variant {
	my ( $self, $variant ) = @_;
	$variant_def{$variant}
	    or $self->wail( "Invalid pass_variant name '$variant'" );
	my $val = $self->get( 'pass_variant' ) & $variant_def{$variant};
	return $val;
    }

}

sub _set_spacetrack {
    my ($self, $name, $val) = @_;
    if (defined $val) {
	instance($val, 'Astro::SpaceTrack')
	    or $self->wail("$name must be an Astro::SpaceTrack instance");
	my $version = $val->VERSION();
	$version =~ s/ _ //smxg;
	$version >= ASTRO_SPACETRACK_VERSION
	    or $self->wail("$name must be Astro::SpaceTrack version ",
	    ASTRO_SPACETRACK_VERSION, ' or greater' );
    }
    return ($self->{$name} = $val);
}

sub _set_stdout {
    my ($self, $name, $val) = @_;
    $self->{frame}
	and $self->{frame}[-1]{$name} = $val;
    return ($self->{$name} = $val);
}

sub _set_sun_class {
    my ( $self, $name, $val ) = @_;
    $self->_attribute_exists( $name );
    return $self->sky( class => $name, $val );
}

sub _set_time_parser {
    my ( $self, $name, $val ) = @_;

    if ( CODE_REF eq ref $val ) {
	$val = _set_time_parser_code( $val );
    } elsif ( defined $val and my $macro = $self->{macro}{$val} ) {
	$val = _set_time_parser_code(
	    $macro->implements( $val, required => 1 ),
	    $val,
	);
    }

    return $self->_set_copyable(
	name	=> $name,
	value	=> $val,
	class	=> 'Astro::App::Satpass2::ParseTime',
	message	=> 'Unknown time parser',
	default	=> 'Astro::App::Satpass2::ParseTime',
	nocopy	=> 1,
	prefix	=> [ 'Astro::App::Satpass2::ParseTime' ],
    );
}

sub _set_time_parser_attribute {
    my ( $self, $name, $val ) = @_;
    defined $val and $val eq 'undef' and $val = undef;
    $self->{time_parser}->$name( $val );
    return $val;
}

sub _set_time_parser_code {
    my ( $code, $name ) = @_;
    require Astro::App::Satpass2::ParseTime::Code;
    my $obj = Astro::App::Satpass2::ParseTime::Code->new();
    return $obj->code( $code, $name );
}

_frame_pop_force_set ( 'twilight' );	# Force use of the set() method
					# in _frame_pop(), because we
					# need to set {_twilight} as
					# well.
sub _set_twilight {
    my ($self, $name, $val) = @_;
    if (my $key = $twilight_abbr{lc $val}) {
	$self->{$name} = $key;
	$self->{_twilight} = $twilight_def{$key};
    } else {
	my $angle = $self->__parse_angle( { accept => 1 }, $val );
	looks_like_number( $angle )
	    or $self->wail( 'Twilight must be number or known keyword' );
	$self->{$name} = $val;
	$self->{_twilight} = deg2rad ($angle);
    }
    return $val;
}

sub _set_tz {
    my ( $self, $name, $val ) = @_;
    $self->_set_formatter_attribute( $name, $val );
    $self->_set_time_parser_attribute( $name, $val );
    return $val;
}

sub _set_unmodified {
    return ($_[0]{$_[1]} = $_[2]);
}

sub _set_warner_attribute {
    my ( $self, $name, $val ) = @_;
    defined $val and $val eq 'undef' and $val = undef;
    $self->{_warner}->$name( $val );
    return $val;
}

sub _set_webcmd {
    my ($self, $name, $val) = @_;
    # TODO warn if $val is true but not '1'.
    if ( my $st = $self->get( 'spacetrack' ) ) {
	# TODO once spacetrack supports '1', just pass $val.
	$st->set( webcmd => $self->_get_browser_command( $val ) );
    }
    return ($self->{$name} = $val);
}

sub show : Verb( changes! deprecated! readonly! ) Tweak( -completion _readline_complete_subcommand ) {
    my ( $self, $opt, @args ) = __arguments( @_ );

    foreach my $name ( qw{ deprecated readonly } ) {
	exists $opt->{$name} or $opt->{$name} = 1;
    }
    my $output;

    unless ( @args ) {
	foreach my $name ( sort keys %accessor ) {
	    $self->_attribute_exists( $name, query => 1 )
		or next;
	    $nointeractive{$name}
		and next;
	    exists $mutator{$name}
		or $opt->{readonly}
		or next;
	    my $depr;
	    ( $depr = $self->_deprecation_in_progress( attribute =>
		    $name ) )
		and ( not $opt->{deprecated} or $depr >= 3 )
		and next;
	    push @args, $name;
	}
    }

    foreach my $name (@args) {
	exists $shower{$name}
	    or $self->wail("No such attribute as '$name'");

	my @val = $shower{$name}->( $self, $name );
	if ( $opt->{changes} ) {
	    no warnings qw{ uninitialized };
	    $static{$name} eq $val[-1] and next;
	}

	exists $mutator{$name} or unshift @val, '#';
	$output .= quoter( @val ) . "\n";
    }
    return $output;
}

sub _show_copyable {
    my ( $self, $name ) = @_;
    my $obj = $self->get( $name );
    my $val = $obj->class_name_of_record();
    return ( 'set', $name, $val );
}

sub _show_formatter_attribute {
    my ( $self, $name ) = @_;
    my $val = $self->{formatter}->decode( $name );
    return ( qw{ formatter }, $name, $val );
}

# Calls to the following _show_sub method are generated dynamically
# above, so there is no way Perl::Critic can find them.

sub _show_sub {	## no critic (ProhibitUnusedPrivateSubroutines)
    # my ( $app, $text, $line, $start, @arg ) = @_;
    my ( undef, undef, undef, undef, @arg ) = @_;
    @arg > 1
	or return;
    my $re = qr/ \A \Q$arg[-1]\E /smx;
    return [ grep { $_ =~ $re } sort keys %accessor ];
}

sub _show_sun_class {
    my ( $self, $name ) = @_;
    $self->_attribute_exists( $name );
    return $self->_sky_class_components( $name );
}

sub _show_time_parser {
    my ( $self, $name ) = @_;
    my $obj = $self->get( $name );
    my $val = $obj->class_name_of_record();
    if ( my $back_end = $obj->back_end() ) {
	$val = "$val,back_end=$back_end";
    }
    return ( set => $name, $val );
}

sub _show_unmodified {
    my ($self, $name) = @_;
    my $val = $self->get( $name );
    return ( 'set', $name, $val );
}

# For proper motion, we need to convert arc seconds per year to degrees
# per second. Perl::Critic does not like 'use constant' because they do
# not interpolate, but they really do: "@{[SPY2DPS]}".

use constant SPY2DPS => 3600 * 365.24219 * SECSPERDAY;

# Given a body in the sky, encodes it in 'sky add' format
sub _sky_list_body {
    my ( $body ) = @_;
    if ( embodies( $body, 'Astro::Coord::ECI::TLE' ) ) {
	return sprintf "sky tle %s\n", quoter(
	    $body->get( 'tle' ) );
    } elsif ( $body->isa( 'Astro::Coord::ECI::Star' ) ) {
	my ( $ra, $dec, $rng, $pmra, $pmdec, $vr ) = $body->position();
	$rng /= PARSEC;
	$pmra = rad2deg( $pmra / 24 * 360 * cos( $ra ) ) * SPY2DPS;
	$pmdec = rad2deg( $pmdec ) * SPY2DPS;
	return sprintf
	    "sky add %s %s %7.3f %.2f %.4f %.5f %s\n",
	    quoter( $body->get( 'name' ) ), _rad2hms( $ra ),
	    rad2deg( $dec ), $rng, $pmra, $pmdec, $vr;
    } else {
	return sprintf "sky add %s\n", quoter( $body->get( 'name' ) );
    }
}

sub sky : Verb() Tweak( -completion _readline_complete_subcommand ) {
    my ( $self, undef, @args ) = __arguments( @_ );	# $opt unused

    my $verb = lc ( shift @args || 'list' );

    if ( my $code = $self->can( "_sky_sub_$verb") ) {
	return $code->( $self, @args );
    } else {
	$self->wail("'sky' subcommand '$verb' not known");
    }
    return;	# We can't get here, but Perl::Critic does not know this.
}

# Given the name of a potential background object, return its
# definition. This is an array in list context, or a quoted string in
# scalar context.
sub _sky_class_components {
    my ( $self, $name ) = @_;
    my $info = $self->{sky_class}{ fold_case( $name ) }
	or $self->weep( "No class defined for $name" );
    my ( $class, @attr ) = @{ $info };
    # We rely on sky( class => $name, $class, ... ) keeping the name
    # last.
    $name = pop @attr;
    pop @attr;	# 'name';
    my @parts = ( qw{ sky class }, $name, $class, @attr );
    wantarray
	and return @parts;
    return join ' ', map { quoter( $_ ) } @parts;
}

# Given the name of a potential sky object, instantiate it. Named
# arguments are optional; the following are supported:
#   fatal = Whether failure to find the name is fatal. Default is true.
sub _sky_object {
    my ( $self, $name, %opt ) = @_;
    defined $opt{fatal}
	or $opt{fatal} = 1;
    if ( my $info = $self->{sky_class}{ fold_case( $name ) } ) {
	my ( $class, @attr ) = @{ $info };
	return $class->new( @attr );
    } elsif ( $opt{fatal} ) {
	$self->weep( "No class defined for $name" );
    }
    return;
}

# Calls to the following _sky_sub_... methods are generated dynamically
# above, so there is no way Perl::Critic can find them.
#
sub _sky_sub_add : Verb()  {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ( $self, undef, @args ) = __arguments( @_ );	# $opt unused
    my $name = shift @args
	or $self->wail( 'You did not specify what to add' );
    defined $self->_find_in_sky( $name )
	and return;
    if ( my $obj = $self->_sky_object( $name, fatal => 0 ) ) {
	push @{ $self->{sky} }, $obj;
    } else {
	@args >= 2
	    or $self->wail(
	    'You must give at least right ascension and declination' );
	my $ra = deg2rad( $self->__parse_angle( shift @args ) );
	my $dec = deg2rad( $self->__parse_angle( shift @args ) );
	my $rng = @args ?
	    $self->__parse_distance( shift @args, '1pc' ) :
	    10000 * PARSEC;
	my $pmra = @args ? do {
	    my $angle = shift @args;
	    $angle =~ s/ s \z //smxi
		or $angle *= 24 / 360 / cos( $ra );
	    deg2rad( $angle / SPY2DPS );
	} : 0;
	my $pmdec = @args ? deg2rad( shift( @args ) / SPY2DPS ) : 0;
	my $pmrec = @args ? shift @args : 0;
	push @{ $self->{sky} }, Astro::Coord::ECI::Star->new(
	    debug	=> $self->{debug},
	    name	=> $name,
	    sun		=> $self->_sky_object( 'sun' ),
	)->position( $ra, $dec, $rng, $pmra, $pmdec, $pmrec );
    }
    return;
}

sub _sky_sub_class : Verb( add! delete! ) {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ( $self, $opt, @arg ) = __arguments( @_ );

    $opt->{add}
	and $opt->{delete}
	and $self->wail( 'May not specify both add and delete' );

    if ( $opt->{delete} ) {
	foreach my $name ( @arg ) {
	    $name =~ m/ \A sun \z /smxi
		and $self->wail( 'Can not remove Sun class' );
	    defined $self->_find_in_sky( $name )
		and $self->wail( 'Can not remove in-use class' );
	    delete $self->{sky_class}{ fold_case( $name ) };
	}
    } elsif ( @arg < 2 ) {
	@arg
	    or @arg = sort keys %{ $self->{sky_class} };
	return join '', map {
	    $self->_sky_class_components( $_ ) . "\n" }
	    @arg;
    } else {
	my ( $name, $class, @attr ) = @arg;
	$self->load_package( { fatal => 'wail' }, $class );
	my $want_class = $name =~ m/ \A sun \z /smxi ?
	    SUN_CLASS_DEFAULT :
	    'Astro::Coord::ECI';
	embodies( $class, $want_class )
	    or $self->wail(
	    "Must be a subclass of $want_class" );
	+{ @attr }->{name}
	    and $self->wail( 'May not specify name explicitly' );
	# name must be last, because _sky_class_components()
	# needs to recover it.
	push @attr, name => $name;
	my $obj = $class->new( @attr );
	my $folded_name = fold_case( $name );
	$self->{sky_class}{$folded_name} = [ $class, @attr ];
	$self->_replace_in_sky( $folded_name, $obj )
	    or $opt->{add}
	    and push @{ $self->{sky} }, $obj;
	$self->{_help_module}{$folded_name} = $class;
	if ( $obj->isa( 'Astro::Coord::ECI::Sun' ) ) {
	    foreach my $body (
		@{ $self->{bodies} }, @{ $self->{sky} }
	    ) {
		$body->set(
		    sun => $self->_sky_object( 'sun' ),
		);
	    }
	}
    }

    return;
}

sub _sky_sub_clear : Verb() {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ( $self ) = __arguments( @_ );	# $opt and args unused
    @{ $self->{sky} } = ();
    return;
}

sub _sky_sub_drop : Verb() Tweak( -completion _sky_body_complete ) {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ( $self, undef, @args ) = __arguments( @_ );	# $opt unused
    @args or $self->wail(
	'You must specify at least one name to drop' );
    foreach my $name ( @args ) {
	$self->_drop_from_sky( $name );
    }
    return;
}

sub _sky_sub_list : Verb( verbose! ) {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ( $self, $opt ) = __arguments( @_ );	# args unused
    my $output;
    foreach my $body (
	map { $_->[1] }
	sort { $a->[0] cmp $b->[0] }
	map { [ lc( $_->get( 'name' ) || $_->get( 'id' ) ), $_ ] }
	@{$self->{sky}}
    ) {
	$output .= _sky_list_body( $body );
	if ( $opt->{verbose} ) {
	    $output .= "#   Class: @{[ ref $body ]}\n";
	}
    }
    unless (@{$self->{sky}}) {
	$self->{warn_on_empty}
	    and $self->whinge( 'The sky is empty' );
    }
    return $output;
}

# Undocumented. That means I can revoke at any time, without notice. If
# you need this functionality, please contact me.
sub _sky_sub_load : Verb() {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ( $self, undef, @args ) = __arguments( @_ );	# $opt unused
    my $tle;
    foreach my $fn ( @args ) {
	local $/ = undef;
	open my $fh, '<', $fn
	    or $self->wail( "Failed to open $fn: $!" );
	$tle .= <$fh>;
	close $fh;
    }
    return $self->_sky_sub_tle( $tle );
}

sub _sky_sub_lookup : Verb() {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ( $self, undef, @args ) = __arguments( @_ );	# $opt unused
    my $output;
    my $name = shift @args;
    defined $self->_find_in_sky( $name )
	and $self->wail( "Duplicate sky entry '$name'" );
    my ($ra, $dec, $rng, $pmra, $pmdec, $pmrec) =
	$self->_simbad4 ($name);
    $rng = sprintf '%.2f', $rng;
    $output .= 'sky add ' . quoter ($name) .
	" $ra $dec $rng $pmra $pmdec $pmrec\n";
    $ra = deg2rad ($self->__parse_angle ($ra));
    my $body = Astro::Coord::ECI::Star->new(
	name	=> $name,
	sun	=> $self->_sky_object( 'sun' ),
      );
    $body->position ($ra, deg2rad ($self->__parse_angle ($dec)),
	$rng * PARSEC, deg2rad ($pmra * 24 / 360 / cos ($ra) / SPY2DPS),
	deg2rad ($pmdec / SPY2DPS), $pmrec);
    push @{$self->{sky}}, $body;
    return $output;
}

# Undocumented. That means I can revoke at any time, without notice. If
# you need this functionality, please contact me.
sub _sky_sub_tle : Verb() {
    my ( $self, undef, $tle ) = __arguments( @_ );	# $opt unused
    my @bodies = Astro::Coord::ECI::TLE::Set->aggregate(
	Astro::Coord::ECI::TLE->parse( $tle ) );
    my %extant = map { $_->get( 'id' ) => 1 }
	grep { embodies( $_, 'Astro::Coord::ECI::TLE' ) }
	@{ $self->{sky} };
    foreach my $body ( @bodies ) {
	my $id = $body->get( 'id' );
	$extant{$id}
	    and $self->wail( "Duplicate sky entry $id" );
    }
    push @{ $self->{sky} }, @bodies;
    return sprintf "sky tle %s\n", quoter( $tle );
}

sub source : Verb( optional! ) {
    my ( $self, $opt, $src, @args ) = __arguments( @_ );

    my $output;
    my $reader = $self->_file_reader( $src, $opt )
	or return;

    my @level1_cache;
    my $level1_context = {};
    my $fetcher = $opt->{level1} ? sub {
	@level1_cache
	    and return shift @level1_cache;
	my $buffer = $reader->();
	@level1_cache = $self->_rewrite_level1_command(
	    $buffer, $level1_context );
	return shift @level1_cache;
    } : $reader;

    my $frames = $self->_frame_push( source => \@args );
    # Note that level1 is unsupported, and works only when the
    # options are passed as a hash. It will go away when support for
    # the original satpass script is dropped.
    $self->{frame}[-1]{level1} = $opt->{level1};
    my $err;
    my $ok = eval { while ( defined( my $input =  $fetcher->() ) ) {
	    if ( defined ( my $buffer = $self->execute( $fetcher,
			    $input ) ) ) {
		$output .= $buffer;
	    }
	}
	1;
    } or $err = $@;

    $self->_frame_pop( $frames );
    $ok or $self->whinge( $err );

    $opt->{level1} and $self->_rewrite_level1_macros();
    return $output;
}

{

    my %handler = (
	config	=> sub {
	    my ( $self, $obj, undef, $opt, @args ) = @_;	# $method unused
	    @args or @args = $obj->attribute_names();
	    my ( $rslt, @values, $virgin );
	    $opt->{changes}
		and $virgin = $self->_get_spacetrack_default();
	    foreach my $name ( @args ) {
		$rslt = $obj->get( $name );
		$rslt->is_success()
		    or return $rslt;
		my $value = $rslt->content();
		no warnings qw{ uninitialized };
		$opt->{changes}
		    and $value eq $virgin->getv( $name )
		    and next;
		push @values, [ $name, $value ];
	    }
	    if ( $opt->{raw} ) {
		$rslt->content( \@values );
	    } else {
		$opt->{raw} and return \@values;
		my $output = '';
		foreach ( @values ) {
		    $output .= quoter( qw{ spacetrack set }, @{ $_ } ) . "\n";
		}
		$rslt->content( $output );
	    }
	    return $rslt;
	},
	get	=> sub {
	    my ( undef, $obj, undef, $opt, @args ) = @_;	# Invocant, $method unused
	    my $rslt = $obj->get( @args );
	    $rslt->is_success
		and not $opt->{raw}
		and $rslt->content( scalar quoter(
		    qw{ spacetrack set }, $args[0], $rslt->content() ) );
	    return $rslt;
	},
	set	=> sub {
	    my ( undef, $obj, $method, undef, @args ) = @_;	# Invocant, $opt unused
	    return $obj->$method( @args );
	},
    );
    $handler{getv} = $handler{get};
    $handler{show} = $handler{config};
    $handler{spacetrack_query_v2} = $handler{set};

    my %suppress_output = map { $_ => 1 } '', 'set';

    # Attributes must all be on one line to process correctly under
    # 5.8.8.
    sub spacetrack : Verb( all! changes! descending! effective! end_epoch=s exclude=s last5! raw! rcs! status=s sort=s start_epoch=s tle! verbose! ) {
	my ( $self, $opt, $method, @args ) = __arguments( @_ );

	exists $opt->{raw}
	    or $opt->{raw} = ( ! _is_interactive() );

	my $verbose = delete $opt->{verbose};

	my $object = $self->_helper_get_object( 'spacetrack' );
	$method !~ m/ \A _ /smx and $object->can( $method )
	    or $handler{$method}
	    or $self->wail("No such spacetrack method as '$method'");

	$opt->{start_epoch}
	    and $opt->{start_epoch} = $self->__parse_time(
		$opt->{start_epoch} );
	$opt->{end_epoch}
	    and $opt->{end_epoch} = $self->__parse_time(
		$opt->{end_epoch} );

	my ( $rslt, @rest );
       	if ( $handler{$method} ) {
	    ( $rslt, @rest ) = $handler{$method}->(
		$self, $object, $method, $opt, @args );
	} else {
	    delete $opt->{raw};
	    ( $rslt, @rest ) = $object->$method( $opt, @args );
	}

	$rslt->is_success()
	    or $self->wail( $rslt->status_line() );

	my $output;
	my $content_type = $object->content_type || '';

	if ($content_type eq 'orbit') {

	    push @{$self->{bodies}},
		Astro::Coord::ECI::TLE->parse ($rslt->content);
	    $verbose
		and $output .= $rslt->content;

	} elsif ($content_type eq 'iridium-status') {

	    $self->_iridium_status( @rest );
	    $verbose
		and $output .= $rslt->content;

	} elsif ( ! $suppress_output{$content_type} || $verbose ) {

	    $output .= $rslt->content;

	}

	defined $output
	    and $output =~ s/ (?
	return $output;
    }

}

sub st : Verb() {
    my ( $self, undef, $func, @args ) = __arguments( @_ );	# $opt unused

    $self->_deprecation_notice( method => 'st' );
    if ( 'localize' eq $func ) {
	my $st = $self->_helper_get_object( 'spacetrack' );
	foreach my $key (@args) {
	    exists $self->{frame}[-1]{spacetrack}{$key}
		or $self->{frame}[-1]{spacetrack}{$key} =
		$st->get ($key)->content
	}
    } else {
	goto &spacetrack;
    }
    return;
}

sub station {
    my ( $self ) = @_;

    defined $self->{height}
	and defined $self->{latitude}
	and defined $self->{longitude}
	or $self->wail( 'You must set height, latitude, and longitude' );

    return Astro::Coord::ECI->new (
	    almanac_horizon	=> $self->{_almanac_horizon},
	    horizon	=> deg2rad( $self->get( 'horizon' ) ),
	    id		=> 'station',
	    name	=> $self->{location} || '',
	    refraction	=> $self->{refraction} || 0,
	)->geodetic (
	    deg2rad( $self->{latitude} ),
	    deg2rad( $self->{longitude} ),
	    $self->{height} / 1000
	);
}

# TODO I must have thought -reload would be good for something, but it
# appears I never implemented it.

sub status : Verb( name! reload! ) {
    my ( $self, $opt, @args ) = __arguments( @_ );

    @args or @args = qw{show};

    my $verb = lc (shift (@args) || 'show');

    if ( $verb eq 'iridium' ) {
	$self->_deprecation_notice( status => 'iridium', 'show' );
	$verb = 'show';
    }

    my $output;

    if ($verb eq 'add' || $verb eq 'drop') {

	Astro::Coord::ECI::TLE->status ($verb, @args);
	foreach my $tle (@{$self->{bodies}}) {
	    $tle->get ('id') == $args[0] and $tle->rebless ();
	}

    } elsif ($verb eq 'clear') {

	Astro::Coord::ECI::TLE->status ($verb, @args);
	foreach my $tle (@{$self->{bodies}}) {
	    $tle->rebless ();
	}

    } elsif ($verb eq 'show' || $verb eq 'list') {

	my @data = Astro::Coord::ECI::TLE->status( 'show', @args );
	@data = sort {$a->[3] cmp $b->[3]} @data if $opt->{name};
	$output .= '';	# Don't want it to be undef.

	my $encoder = ( HAVE_TLE_IRIDIUM &&
	    Astro::Coord::ECI::TLE::Iridium->can(
	    '__encode_operational_status' ) ) || sub { return $_[2] };

	foreach my $tle (@data) {
	    my $status = $encoder->( undef, status => $tle->[2] );
	    $output .= quoter( 'status', 'add',
		$tle->[0], $tle->[1], $status,
		$tle->[3], $tle->[4] ) . "\n";
	}

    } else {
	$output .= '';	# Don't want it to be undef.
	$output .= Astro::Coord::ECI::TLE->status ($verb, @args);
    }

    return $output;

}

sub system : method Verb() {	## no critic (ProhibitBuiltInHomonyms)
    my ( $self, undef, $verb, @args ) = __arguments( @_ );	# $opt unused

    @args = map {
	bsd_glob( $_, GLOB_NOCHECK | GLOB_BRACE | GLOB_QUOTE )
    } @args;
    my $stdout = $self->{frame}[-1]{localout};
    my @exported = keys %{ $self->{exported} };
    local @ENV{@exported} = map { $mutator{$_} ? $self->get( $_ ) :
	$self->{exported}{$_} } @exported;
    if ( defined $stdout && -t $stdout ) {
	CORE::system {$verb} $verb, @args;
	return;
    } else {
	$self->load_package( { fatal => 'wail' }, 'IPC::System::Simple' );
	return IPC::System::Simple::capturex( $verb, @args );
    }
}

sub time : method Verb() Tweak( -unsatisfied ) {	## no critic (ProhibitBuiltInHomonyms,RequireArgUnpacking)
    my ($self, @args) = map { ARRAY_REF eq ref $_ ? @{ $_ } : $_ } @_;
    $have_time_hires->() or $self->wail( 'Time::HiRes not available' );
    $self->_dispatch_check( time => $args[0] );
    my $start = Time::HiRes::time();
    # If we're inside an unsatisfied if() we do not do the timing,
    # because dispatch() is probably a no-op.
    $self->_in_unsatisfied_if()
	or $self->_add_post_dispatch(
	sub {
	    return sprintf "%.3f seconds\n", Time::HiRes::time() - $start;
	},
    );
    return $self->dispatch( @args );
}

sub time_parser : Verb() {
    splice @_, ( HASH_REF eq ref $_[1] ? 2 : 1 ), 0, 'time_parser';
    goto &_helper_handler;
}

sub tle : Verb( :compute __tle_options ) {
    my ( $self, $opt, @args ) = __arguments( @_ );
    @args
	and not $opt->{choose}
	and $opt->{choose} = \@args;

    my $bodies = $self->__choose( $opt->{choose}, $self->{bodies} );
    @{ $bodies } = map { $_->[0] }
	sort { $a->[1] <=> $b->[1] || $a->[2] <=> $b->[2] }
	map { [ $_, $_->get( 'id' ), $_->get( 'epoch' ) ] }
	@{ $bodies };
    my $tplt_name = delete $opt->{_template};
    return $self->__format_data( $tplt_name => $bodies, $opt );
}

sub __tle_options {
    my ( $self, $opt ) = @_;
    return [
	qw{ choose=s@ },
	$self->_templates_to_options( tle => $opt ),
    ];
}

sub unexport : Verb() {
    my ( $self, undef, @args ) = __arguments( @_ );	# $opt unused

    foreach my $name ( @args ) {
	delete $self->{exported}{$name};
    }
    return;
}

sub validate : Verb( quiet! ) {
    my ( $self, $opt, @args ) = __arguments( @_ );

    my $pass_start = $self->__parse_time (
	shift @args, $self->_get_day_noon());
    my $pass_end = $self->__parse_time (shift @args || '+7');
    $pass_start >= $pass_end
	and $self->wail( 'End time must be after start time' );

    @{ $self->{bodies} }
	or $self->wail( 'No bodies selected' );

#	Validate each body.

    my @valid;
    foreach my $tle ( $self->_aggregate( $self->{bodies} ) ) {
	$tle->validate( $opt, $pass_start, $pass_end )
	    and push @valid, $tle->members();
    }

    $self->{bodies} = \@valid;

    return;
}

sub version : Verb() {
    return <<"EOD";

@{[__PACKAGE__]} $VERSION - Satellite pass predictor
based on Astro::Coord::ECI @{[Astro::Coord::ECI->VERSION]}
Copyright (C) 2009-2025 by Thomas R. Wyant, III

EOD
}

########################################################################

#   $self->_add_post_dispatch( $code_ref );

#   Add a reference to code to be executed after the current interactive
#   method is dispatched. All such code is executed, in the reverse of
#   the order it was added. The only argument will be the invocant.
#   Because it is added to the current execution frame, if the
#   interactive method being dispatched is begin(), the code will be
#   executed after the corresponding end(). Code to make the execution
#   happen is, of course, in dispatch().
sub _add_post_dispatch {
    my ( $self, $code ) = @_;
    push @{ $self->{frame}[-1]{post_dispatch} ||= [] }, $code;
    return;
}

#	$self->_aggregate( $list_ref );

sub __add_to_observing_list {
    my ( $self, @args ) = @_;
    foreach my $body ( @args ) {
	embodies( $body, 'Astro::Coord::ECI::TLE' )
	    and next;
	my $id = $body->get( 'id' );
	defined $id
	    or $id = $body->get( 'name' );
	$self->wail( "Body $id is not a TLE" );
    }
    push @{ $self->{bodies} }, @args;
    return $self;
}

#	This is just a wrapper for
#	Astro::Coord::ECI::TLE::Set->aggregate.

sub _aggregate {
    my ( $self, $bodies ) = @_;
    local $Astro::Coord::ECI::TLE::Set::Singleton = $self->{singleton};
    return Astro::Coord::ECI::TLE::Set->aggregate ( @{ $bodies } );
}

#	_apply_boolean_default( \%opt, $invert, @keys );
#
#	This subroutine defaults a set of boolean options. The keys in
#	the set are specified in @keys, and the defined values are
#	inverted before the defaults are applied if $invert is true.
#	Nothing is returned.

sub _apply_boolean_default {
    my ( $self, $opt, $invert, @keys ) = @_;
    my $state = my $found = 0;
    foreach my $key ( @keys ) {
	if ( exists $opt->{$key} ) {
	    $found++;
	    $invert
		and $opt->{$key} = ( !  $opt->{$key} );
	    $state |= ( $opt->{$key} ? 2 : 1 );
	}
    }
    1 == $state			# Only negated options found
	and @keys == $found	# All options in group were specified
	and $self->wail( 'May not negate all of ' . join ', ', map {
	    "-$_" } @keys );
    my $default = $state < 2;
    foreach my $key ( @keys ) {
	exists $opt->{$key}
	    or $opt->{$key} = $default;
    }
    return;
}

#	$self->_attribute_exists( $name, %arg );
#
#	This method returns true if an accessor for the given attribute
#	exists, and croaks otherwise.
#	Attributes in the %level1_attr hash fail unless in level1 mode
#	Named arguments:
#	  query: if true, returns false if attribute does not exist

{
    my %level1_attr = map { $_ => 1 } qw{ sun };

    sub _attribute_exists {
	my ( $self, $name, %arg ) = @_;
	exists $accessor{$name}
	    and ( ! $level1_attr{$name} || $self->{frame}[-1]{level1} )
	    and return $accessor{$name};
	$arg{query}
	    or $self->wail("No such attribute as '$name'");
	return;
    }
}

{

    my %spacetrack_attributes;
    $have_astro_spacetrack->()
	and %spacetrack_attributes = map { $_ => 1 }
	Astro::SpaceTrack->attribute_names();

    my %special = (
	formatter	=> sub {
	    my ( $obj, $attr ) = @_;
	    $obj->can( $attr )
		or return NULL;
	    return $obj->$attr();
	},
	spacetrack	=> sub {
	    my ( $obj, $attr ) = @_;
	    $spacetrack_attributes{$attr}
		or return NULL;
	    return $obj->getv( $attr );
	},
	time_parser	=> sub {
	    my ( $obj, $attr ) = @_;
	    $obj->can( $attr )
		or return NULL;
	    return $obj->$attr();
	},
    );

    # my $value = $self->_attribute_value( $name );
    #
    # Return an attribute value. If the attribute is 'formatter',
    # 'spacetrack' or 'time_parser' you can specify a dot and the name
    # of an attribute of the relevant object, e.g. spacetrack.username.
    # If the attribute does not exist you get back manifest constant
    # NULL, which is a reference to undef blessed into class 'Null'.
    sub _attribute_value {
	my ( $self, $name ) = @_;
	my ( $attr, $sub ) = split qr{ [.] }smx, $name, 2;
	$accessor{$attr}
	    or return NULL;
	my $rslt = $self->get( $attr );
	if ( defined $sub ) {
	    $rslt
		and my $code = $special{$attr}
		or return NULL;
	    $rslt = $code->( $rslt, $sub );
	}
	return $rslt;
    }
}

# Documented in POD

{
    my %chooser = (
        ''	=> sub {
	    my ( $sel ) = @_;
	    my @rslt;
	    foreach my $s ( split qr{ \s* , \s* }smx, $sel ) {
		if ( $s =~ m/ \D /smx || $s < 1000 ) {
		    my $re = qr{\Q$s\E}i;
		    push @rslt, sub {
			my ( $tle, $context ) = @_;
			$context->{name} ||= $tle->get( 'name' );
			defined $context->{name}
			    or return;
			return $context->{name} =~ $re;
		    };
		} else {
		    push @rslt, sub {
		        my ( $tle, $context ) = @_;
			$context->{id} ||= $tle->get( 'id' );
			return $context->{id} == $s;
		    };
		}
	    }
	    return @rslt;
	},
	CODE_REF()	=> sub {
	    my ( $sel ) = @_;
	    return $sel;
	},
	REGEXP_REF()	=> sub {
	    my ( $sel ) = @_;
	    return sub {
	        my ( $tle, $context ) = @_;
		$context->{name} ||= $tle->get( 'name' );
		return $context->{name} =~ $sel;
	    };
	},
    );

    sub __choose {
	my ( $self, @args ) = @_;
	my $opt = HASH_REF eq ref $args[0] ? shift @args : {};
	my $choice = shift @args;
	defined $choice
	    or $choice = [];
	ARRAY_REF eq ref $choice
	    or $self->weep( 'Choice must be an ARRAY ref' );
	my @rslt;
	my @selector;
	foreach my $sel ( @{ $choice } ) {
	    my $ref = ref $sel;
	    my $code = $chooser{$ref}
	    or $self->weep( "$ref not supported as chooser" );
	    push @selector, $code->( $sel );
	}

	$opt->{bodies}
	    and push @args,
		$self->_aggregate( $self->{bodies} );
	$opt->{sky}
	    and push @args, $self->{sky};

	@args = map { ARRAY_REF eq ref $_ ? @{ $_ } : $_ } @args;

	not @selector
	    and return wantarray ? @args : \@args;

	foreach my $tle ( @args ) {
	    ARRAY_REF eq ref $tle
		and $self->weep( 'Schwartzian-transform objects not supported' );

	    my $match = $opt->{invert};
	    my $context = {};
	    foreach my $sel ( @selector ) {
		$sel->( $tle, $context )
		    or next;
		$match = !$match;
		last;
	    }

	    $match and push @rslt, $tle;
	}

	return wantarray ? @rslt : \@rslt;
    }

}

#	$self->_deprecation_notice( $type, $name );
#
#	This method centralizes deprecation. Type is 'attribute' or
#	'method'. Deprecation is driven of the %deprecate hash. Values
#	are:
#	    false - no warning
#	    1 - warn on first use
#	    2 - warn on each use
#	    3 - die on each use.
#
#	$self->_deprecation_in_progress( $type, $name )
#
#	This method returns true if the deprecation is in progress. In
#	fact it returns the deprecation level.

{

    my %deprecate = (
	attribute => {
	    country	=> 0,
	    date_format	=> 0,
	    desired_equinox_dynamical	=> 0,
	    explicit_macro_delete	=> 0,
	    gmt		=> 0,
	    local_coord	=> 0,
	    perltime	=> 0,
	    time_format	=> 0,
	    tz		=> 0,
	},
	method => {
	    st		=> 0,
	},
	status	=> {
	    iridium	=> 3,
	},
    );

    sub _deprecation_notice {
	my ( $self, $type, $name, $repl ) = @_;
	$deprecate{$type} or return;
	$deprecate{$type}{$name} or return;
	my $msg = sprintf 'The %s %s is %s', $name, $type,
	    $deprecate{$type}{$name} > 2 ? 'removed' : 'deprecated';
	defined $repl
	    and $msg .= "; use $repl instead";
	$deprecate{$type}{$name} >= 3
	    and $self->wail( $msg );
	warnings::enabled( 'deprecated' )
	    and $self->whinge( $msg );
	$deprecate{$type}{$name} == 1
	    and $deprecate{$type}{$name} = 0;
	return;
    }

    sub _deprecation_in_progress {
	my ( undef, $type, $name ) = @_;	# Invocant unused
	$deprecate{$type} or return;
	return $deprecate{$type}{$name};
    }

}

# my ( $obj ) = $self->_drop_from_sky( $name );
# The return is an array containing the dropped body, or nothing if the
# body was not found.
sub _drop_from_sky {
    my ( $self, $name ) = @_;
    defined( my $inx = $self->_find_in_sky( $name ) )
	or return;
    return splice @{ $self->{sky} }, $inx, 1;
}

#	$fh = $self->_file_opener( $name, $mode );
#
#	This method opens the given file, returning the handle. If the
#	mode is output, the current value of output_layers is appended.
#	An exception is thrown if the file can not be opened.

sub _file_opener {
    my ( $self, $name, $mode ) = @_;

    # NOTE special case for &1 (stdout) and &2 (stderr).
    my $fh = ( $name =~ m/ \A & ( [12] ) \z /smx ) ?
	[
	    undef,
	    $self->{frame}[-1]{localout} || \*STDOUT,
	    \*STDERR,
	]->[ $1 ] :
	IO::File->new( $name, $mode )
	or $self->wail( "Unable to open $name: $!" );

    if ( $mode =~ m/ \A (?: [+>] | [|] - ) /smx ) {

	my $layers = $self->get( 'output_layers' );
	if ( defined $layers && '' ne $layers ) {
	    binmode $fh, $layers
		or $self->wail(
		"Unable to set '$layers' on $name: $!" );
	}
    }

    return $fh;
}

#	$code = $self->_file_reader( $file, \%opt );
#
#	This method returns a code snippet that returns the contents of
#	the file one line at a time. The $file can be any of:
#
#	* An open handle
#	* A URL (if LWP::UserAgent can be loaded)
#	* A file name
#	* A scalar reference
#	* An array reference
#	* A code reference, which is returned unmodified
#
#	The code snippet will return undef at end-of-file.
#
#	The following keys in %opt are recognized:
#	{encoding} specifies the encoding of the file. How this is used
#	    on the $file argument as follows:
#	    * An open handle -- unused
#	    * A URL ----------- unused (encoding taken from HTTP::Response)
#	    * A file name ----- used (default is utf-8)
#	    * A scalar ref ---- used (default is un-encoded)
#	    * An array ref ---- unused
#	    * A code ref ------ unused
#	{glob} causes the contents of the file to be returned, rather
#	    than a reader.
#	{optional} causes the code to simply return on an error, rather
#	    than failing.

sub _file_reader {
    my ( $self, $file, $opt ) = @_;

    if ( openhandle( $file ) ) {
	$opt->{glob}
	    or return sub { return scalar <$file> };
	local $/ = undef;
	return scalar <$file>;
    }

    my $ref = ref $file;
    my $code = $self->can( "_file_reader_$ref" )
	or $self->wail( sprintf "Opening a $ref ref is unsupported" );

    goto &$code;
}

# Most of the following are called using '$self->can(
# "_file_reader_$ref" )', and there is no way a static analysis tool can
# find such calls. So we just have to exempt them from Perl::Critic

sub _file_reader_ {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ( $self, $file, $opt ) = @_;
    $opt ||= {};

    defined $file
	and chomp $file;

    if ( ! defined $file || ! ref $file &&  '' eq $file ) {
	$opt->{optional} and return;
	$self->wail( 'Defined file required' );
    }

    if ( $self->_file_reader__validate_url( $file ) ) {
	my $ua = LWP::UserAgent->new();
	my $resp = $ua->get( $file );
	$resp->is_success()
	    or do {
	    $opt->{optional} and return;
	    $self->wail( "Failed to retrieve $file: ",
		$resp->status_line() );
	};
	$opt = { %{ $opt }, encoding => $resp->content_charset() };
	return $self->_file_reader(
	    \( scalar $resp->content() ),
	    $opt,
	);
    } else {
	my $encoding = $self->_file_reader__encoding( $opt );
	open my $fh, "<$encoding", $self->expand_tilde( $file )	## no critic (RequireBriefOpen)
	    or do {
	    $opt->{optional} and return;
	    $self->wail( "Failed to open $file: $!" );
	};
	$opt->{glob}
	    or return sub { return scalar <$fh> };
	local $/ = undef;
	return scalar <$fh>;
    }
}

sub _file_reader__encoding {
    my ( undef, $opt ) = @_;
    $opt ||= {};
    my $encoding = $opt->{encoding} || 'utf-8';
    $encoding = ":encoding($encoding)";
    OS_IS_WINDOWS
	and substr $encoding, 0, 0, ':crlf';
    return $encoding;
}


sub _file_reader__validate_url {
    my ( undef, $url ) = @_;		# Invocant unused

    load_package( 'LWP::UserAgent' )
	or return;

    load_package( 'URI' )
	or return;

    load_package( 'LWP::Protocol' )
	or return;

    my $obj = URI->new( $url )
	or return;
    $obj->can( 'authority' )
	or return 1;

    defined( my $scheme = $obj->scheme() )
	or return;
    LWP::Protocol::implementor( $scheme )
	or return;

    return 1;
}

sub _file_reader_ARRAY {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ( undef, $file, $opt ) = @_;	# Invocant unused

    my $inx = 0;
    $opt->{glob}
	or return sub { return $file->[$inx++] };
    my $buffer;
    foreach ( @{ $file } ) {
	$buffer .= $_;
	$buffer =~ m/ \n \z /smx
	    or $buffer .= "\n";
    }
    return $buffer;
}

sub _file_reader_CODE {		## no critic (ProhibitUnusedPrivateSubroutines)
    my ( undef, $file, $opt ) = @_;	# Invocant unused
    $opt->{glob}
	or return $file;
    my $buffer;
    local $_;
    while ( defined( $_ = $file->() ) ) {
	$buffer .= $_;
	$buffer =~ m/ \n \z /smx
	    or $buffer .= "\n";
    }
    return $buffer;
}

sub _file_reader_SCALAR {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ( $self, $file, $opt ) = @_;

    my $encoding = $self->_file_reader__encoding( $opt );
    open my $fh, "<$encoding", $file	## no critic (RequireBriefOpen)
	or do {
	$opt->{optional} and return;
	$self->wail( "Failed to open SCALAR reference: $!" );
    };
    $opt->{glob}
	or return sub { return scalar <$fh> };
    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}) {
	    $self->wail('Input ended on continued line');
	}
	return;
    }

    # Force use of the set() method even if there is an attribute of the
    # same name.
    sub _frame_pop_force_set {
	foreach my $name ( @_ ) {
	    $force_set{$name} = 1;
	}
	return;
    }
}

sub _get_browser_command {
    my ( $self, $val ) = @_;
    defined $val
	or $val = $self->{webcmd};
    defined $val
	and '' ne $val
	or return $val;
    '1' eq $val
	or return $val;
    require Browser::Open;
    return Browser::Open::open_browser_cmd();
}

#	$dumper = $self->_get_dumper();
#
#	This method returns a reference to code that can be used to dump
#	data. The first time it is called it goes through a list of
#	possible classes, and uses the first one it can load, dying if
#	it can not load any of them. After the first successful call, it
#	simply returns the cached dumper.

{
    my $dumper;
    my %kode = (
	'Data::Dumper' => sub {
	    local $Data::Dumper::Terse = 1;
	    Data::Dumper::Dumper(@_);
	},
    );
    sub _get_dumper {
	my ($self) = @_;
	my %dmpr;
	my @mod;
	return $dumper ||= do {
	    foreach (qw{YAML::Dump Data::Dumper::Dumper}) {
		my ($module, $routine) = m/ (.*) :: (.*) /smx;
		push @mod, $module;
		$dmpr{$module} = $routine;
	    }
	    my $mod = $self->_load_module(@mod);
	    $kode{$mod} || $mod->can($dmpr{$mod});
	};
    }
}

#	$fmt = $satpass2->_get_dumper_object();
#
#	Gets a dumper object. This object must conform to the
#	Astro::App::Satpass2::Format interface.

{

    my $dumper;

    sub _get_dumper_object {
	return ( $dumper ||= do {
		require Astro::App::Satpass2::Format::Dump;
		Astro::App::Satpass2::Format::Dump->new();
	    }
	);
    }

}

#	$fmt = $satpass2->_get_formatter_object( $opt );
#
#	Gets the Astro::App::Satpass2::Format object. If $opt->{dump} is true,
#	returns a dumper object; otherwise returns the currently-set
#	formatter object.

sub _get_formatter_object {
    my ( $self, $opt ) = @_;
    $opt ||= {};
    return ( $opt && $opt->{dump} ) ? $self->_get_dumper_object() :
	$self->get( 'formatter' );
}

sub _get_formatter_attribute {
    my ( $self, $name ) = @_;
    return $self->get( 'formatter' )->$name();
}

#	$st = $satpass2->_get_geocoder()

#	Gets the geocoder object, instantiating it if
#	necesary.

sub _get_geocoder {
    my ( $self ) = @_;
    if ( ! exists $self->{geocoder} ) {
	my ( $class, $obj );
	$class = $default_geocoder->()
	    and $obj = $class->new();
	$self->{geocoder} = $obj;
    }
    return $self->{geocoder};
}

#	$boolean = $satpass2->_get_interactive();
#
#	This method returns true if the script is running interactively,
#	and false otherwise. Currently, it returns the results of -t
#	STDIN.

sub _get_interactive {
    return -t STDIN;
}

#	$code = $satpass2->_get_readline();
#
#	Returns code to read input. The code takes an argument which
#	will be used as a prompt if one is needed. What is actually
#	returned is:
#
#	If $satpass2->_get_interactive() is false, the returned code
#	just reads standard in. Otherwise,
#
#	if Term::ReadLine can be loaded, a Term::ReadLine object is
#	instantiated if need be, and the returned code calls
#	Term::ReadLine->readline($_[0]) and returns whatever that gives
#	you. Otherwise,
#
#	Otherwise the returned code writes its argument to STDERR and
#	reads STDIN.
#
#	Note that the return from this subroutine may or may not be
#	chomped.

my $readline_word_break_re;

{
    my $rl;

    sub _get_readline {
	my ($self) = @_;
	# The Perl::Critic recommendation is IO::Interactive, but that
	# fiddles with STDOUT. We want STDIN, because we want to behave
	# differently if STDIN is a pipe, but not if STDOUT is a pipe.
	# We're still missing the *ARGV logic, but that's OK too, since
	# we use the contents of @ARGV as commands, not as file names.
	return do {
	    my $buffer = '';
	    if ($self->_get_interactive()) {
		eval {
		    load_package( 'Term::ReadLine' )
			or return;
		    unless ( $rl ) {
			$rl = Term::ReadLine->new( 'satpass2' );
			if ( 'Term::ReadLine::Perl' eq $rl->ReadLine() ) {

			    $readline_word_break_re ||= qr<
				[\Q$readline::rl_completer_word_break_characters\E]+
			    >smx;

			    no warnings qw{ once };
			    $readline::rl_completion_function = sub {
				my ( $text, $line, $start ) = @_;
				return $self->__readline_completer(
				    $text, $line, $start );
			    };
			}
		    }
		    sub {
			defined $buffer or return $buffer;
			return ( $buffer = $rl->readline($_[0]) );
		    }
		} || sub {
		    defined $buffer or return $buffer;
		    print STDERR $_[0];
		    return (
			$buffer = 	## no critic (ProhibitExplicitStdin)
		    );
		};
	    } else {
		sub {
		    defined $buffer or return $buffer;
		    return (
			$buffer = 	## no critic (ProhibitExplicitStdin)
		    );
		};
	    }
	};
    }
}

sub __readline_completer {
    my ( $app, $text, $line, $start ) = @_;

    $start
	or return $app->_readline_complete_command( $text );

    my ( $cmd ) = split $readline_word_break_re, $line, 2;
    my $code;
    not $cmd =~ s/ \A core [.] //smx
	and ref $app
	and $app->{macro}{$cmd}
	and $code = $app->{macro}{$cmd}->implements( $cmd );
    $code ||= $app->can( $cmd );

    if ( CODE_REF eq ref $code ) {
	# builtins and code macros go here

	my $rslt;

	if ( my $method = $app->__get_attr( $code, Tweak => {}
	    )->{completion} ) {
	    $rslt = $app->$method( $code, $text, $line, $start )
		and return @{ $rslt };
	}

	$rslt = $app->_readline_complete_options( $code, $text,
	    $line, $start )
	    and @{ $rslt }
	    and return @{ $rslt };

    } elsif ( my $macro = $app->{macro}{$cmd} ) {
	# command macros go here

	my $rslt;
	$rslt = $macro->completion( $text )
	    and return @{ $rslt };
    }

    my @files = bsd_glob( "$text*" );
    if ( 1 == @files ) {
	$files[0] .= -d $files[0] ? '/' : ' ';
    } elsif ( $readline::var_CompleteAddsuffix ) {
	foreach ( @files ) {
	    if ( -l $_ ) {
		$_ .= '@';
	    } elsif ( -d $_ ) {
		$_ .= '/';
	    } elsif ( -x _) {
		$_ .= '*';
	    } elsif ( -S _ || -p _ ) {
		$_ .= '=';
	    }
	}
    }
    $readline::rl_completer_terminator_character = '';
    return @files;
}

{
    my @builtins;
    sub _readline_complete_command {
	my ( $app, $text ) = @_;
	unless ( @builtins ) {
	    my $stash = ( ref $app || $app ) . '::';
	    no strict qw{ refs };
	    foreach my $sym ( keys %$stash ) {
		$sym =~ m/ \A _ /smx
		    and next;
		my $code = $app->can( $sym )
		    or next;
		$app->__get_attr( $code, 'Verb' )
		    or next;
		push @builtins, $sym;
	    }
	    @builtins = sort @builtins;
	}
	my @rslt;
	if ( $text =~ s/ \A core [.] //smx ) {
	    my $match = qr< \A \Q$text\E >smx;
	    @rslt = map { "core.$_" } grep { $_ =~ $match } @builtins;
	} else {
	    my $match = qr< \A \Q$text\E >smx;
	    @rslt = grep { $_ =~ $match } @builtins, 'core.',
		ref $app ? keys %{ $app->{macro} } : ();
	}
	1 == @rslt
	    and $rslt[0] =~ m/ \W \z /smx
	    and $readline::rl_completer_terminator_character = '';
	return ( sort @rslt );
    }
}

sub _readline_complete_options {
    # my ( $app, $code, $text, $line, $start ) = @_;
    my ( $app, $code, $text ) = @_;
    $text =~ m/ \A ( --? ) ( .* ) /smx
	or return;
    my ( $prefix, $match ) = ( $1, $2 );
    my $lgl = $app->__legal_options( $code );
    my $re = qr< \A \Q$match\E >smx;
    my @rslt;
    foreach ( @{ $lgl } ) {
	next if ref;
	# De-alias before modifying
	( my $o = $_ ) =~ s/ [!=?] .* //smx;
	push @rslt, grep { m/$re/ } split qr< \| >smx, $o;
    }
    @rslt
	and return [ map { "$prefix$_" } sort @rslt ];
    return;
}

# The following subroutine is called dynamically
sub _readline_complete_subcommand { ## no critic (ProhibitUnusedPrivateSubroutines)
    # my ( $app, $code, $text, $line, $start ) = @_;
    my ( $app, undef, $text, $line, $start ) = @_;
    my @part = _readline_line_to_parts( $line );
    if ( my $code = $app->can( "_$part[0]_sub" ) ) {
	return $code->( $app, $text, $line, $start, @part );
    }
    my @rslt;
    if ( 2 == @part ) {
	my $re = qr< \A _$part[0]_sub_ ( \Q$part[1]\E \w* ) >smx;
	my $stash = ( ref $app || $app ) . '::';
	no strict qw{ refs };
	foreach my $key ( keys %$stash ) {
	    $key =~ m/$re/smx
		and push @rslt, "$1";
	}
	return [ sort @rslt ];
    }

    my $code = $app->can( "_$part[0]_sub_$part[1]" )
	or return;

    my $r;
    $r = $app->_readline_complete_options( $code, $text, $line,
	$start )
	and return $r;

    my $complete = $app->__get_attr( $code, Tweak => {} )->{completion}
	or return;

    $r = $app->$complete( $code, $text, $line, $start )
	and return $r;

    return;
}

sub _macro_list_complete {	## no critic (ProhibitUnusedPrivateSubroutines)
    # my ( $app, $code, $text, $line, $start ) = @_;
    my ( $app, undef, undef, $line, undef ) = @_;
    ref $app
	or return;
    my @part = _readline_line_to_parts( $line );
    3 == @part
	or return;
    my $re = qr< \A \Q$part[2]\E >smx;
    my @rslt;
    foreach ( sort keys %{ $app->{macro} } ) {
	m/$re/smx
	    and push @rslt, $_;
    }
    return \@rslt;
}

sub _sky_body_complete {	## no critic (ProhibitUnusedPrivateSubroutines)
    # my ( $app, $code, $text, $line, $start ) = @_;
    my ( $app, undef, undef, $line, undef ) = @_;
    ref $app
	or return;
    my @part = _readline_line_to_parts( $line );
    3 == @part
	or return;
    my $re = qr< \A \Q$part[2]\E >smxi;
    my @rslt;
    foreach my $body ( @{ $app->{sky} } ) {
	if ( ( my $name = $body->get( 'name' ) ) =~ $re ) {
	    push @rslt, $name;
	} elsif ( ( my $id = $body->get( 'id' ) ) =~ $re ) {
	    push @rslt, $id;
	}
    }
    return [ sort @rslt ];
}

sub _readline_line_to_parts {
    my ( $line ) = @_;
    # NOTE that the field count of -1 causes a trailing separator to
    # result in a trailing empty field.
    my @parts = split $readline_word_break_re, $line, -1;
    # NOTE that we strip the leading 'core.' if any, so the return from
    # this method does not distinguish between a core command and the
    # same-named macro if any.
    @parts
	and $parts[0] =~ s/ \A core [.] //smx;
    return @parts;
}

sub _get_time_parser_attribute {
    my ( $self, $name ) = @_;
    return $self->{time_parser}->$name();
}

#	$st = $satpass2->_get_spacetrack()

#	Gets the Astro::SpaceTrack object, instantiating it if
#	necesary.

sub _get_spacetrack {
    my ( $self ) = @_;
    exists $self->{spacetrack}
	or $self->{spacetrack} = $self->_get_spacetrack_default();
    return $self->{spacetrack};
}

#	$st = $satpass2->_get_spacetrack_default();
#
#	Returns a new Astro::SpaceTrack object, initialized with this
#	object's webcmd, and with its filter attribute set to 1.

sub _get_spacetrack_default {
    my ( $self ) = @_;
    $have_astro_spacetrack->()
	or return;
    return Astro::SpaceTrack->new (
	webcmd => $self->{webcmd},
	filter => 1,
    );
}

sub _get_day_midnight {
    my ( $self, $day ) = @_;
    defined $day
	or $day = time;
    my $gmt = $self->get( 'formatter' )->gmt();
    my @time = $gmt ? gmtime( $day ) : localtime( $day );
    $time[0] = $time[1] = $time[2] = 0;
    $time[5] += 1900;
    return $gmt ? greg_time_gm(@time) : greg_time_local(@time);
}

sub _get_day_noon {
    my ( $self, $day ) = @_;
    defined $day
	or $day = time;
    my $gmt = $self->get( 'formatter' )->gmt();
    my @time = $gmt ? gmtime( $day ) : localtime( $day );
    $time[0] = $time[1] = 0;
    $time[2] = 12;
    $time[5] += 1900;
    return $gmt ? greg_time_gm(@time) : greg_time_local(@time);
}

sub _get_warner_attribute {
    my ( $self, $name ) = @_;
    return $self->{_warner}->$name();
}

sub _helper_get_object {
    my ( $self, $attribute ) = @_;
    my $object = $self->get( $attribute )
	or $self->wail( "No $attribute object available" );
    return $object;
}

{

    my %parse_input = (
	formatter	=> {
	    desired_equinox_dynamical => sub {
		my ( $self, undef, @args ) = @_;	# $opt unused
		if ( $args[0] ) {
		    $args[0] = $self->__parse_time( $args[0], 0 );
		}
		return @args;
	    },
	    format	=> sub {
		my ( $self, $opt, $template, @args ) = @_;
		$opt->{raw} = 1;
		return (
		    arg	=> \@args,
		    sp	=> $self,
		    template	=> $template,
		);
	    },
	},
	time_parser	=> {
	    base	=> sub {
		my ( $self, undef, @args ) = @_;	# $opt unused
		if ( @args && defined $args[0] ) {
		    $args[0] = $self->__parse_time( $args[0], time );
		}
		return @args;
	    }
	},
    );

    sub _helper_handler : Verb( changes! raw! ) {
	my ( $self, $opt, $name, $method, @args ) = __arguments( @_ );

	exists $opt->{raw}
	    or $opt->{raw} = ( ! _is_interactive() );

	defined $method
	    or $self->wail( 'No method name specified' );

	'config' eq $method
	    and return $self->_helper_config_handler( $name => $opt );

	my $object = $self->_helper_get_object( $name );
	$method !~ m/ \A _ /smx and $object->can( $method )
	    or $self->wail("No such $name method as '$method'");

	@args
	    and $parse_input{$name}
	    and $parse_input{$name}{$method}
	    and @args = $parse_input{$name}{$method}->( $self, $opt, @args );
	delete $opt->{raw}
	    and return $object->$method( @args );
	my @rslt = $object->decode( $method, @args );

	instance( $rslt[0], ref $object ) and return;
	ref $rslt[0] and return $rslt[0];
	return quoter( $name, $method, @rslt ) . "\n";
    }
}

sub _helper_config_handler {
    my ( $self, $name, $opt ) = @_;
    my $object = $self->_helper_get_object( $name );
    my $rslt = $object->config(
	changes	=> $opt->{changes},
	decode	=> ! $opt->{raw},
    );
    $opt->{raw} and return $rslt;
    my $output = '';
    foreach my $item ( @{ $rslt } ) {
	$output .= quoter( $name, @{ $item } ) . "\n";
    }
    return $output;
}

#	$satpass2->_iridium_status(\@status)

#	Updates the status of all Iridium satellites from the given
#	array, which is compatible with the second item returned by
#	Astro::SpaceTrack->iridium_status(). If no argument is passed,
#	the status is retrieved using Astro::SpaceTrack->iridium_status()

sub _iridium_status {
    my ($self, $status) = @_;
    unless ($status) {
	my $st = $self->_get_spacetrack();
	(my $rslt, $status) = $st->iridium_status;
	$rslt->is_success or $self->wail($rslt->status_line);
    }

    if ( ARRAY_REF eq ref $status ) {
	Astro::Coord::ECI::TLE->status (clear => 'iridium');
	foreach (@$status) {
	    Astro::Coord::ECI::TLE->status (add => $_->[0], iridium =>
		$_->[4], $_->[1], $_->[3]);
	}
    } else {
	$self->weep(
	    'Portable status not passed, and unavailable from Astro::SpaceTrack'
	);
    }

    foreach my $tle (@{$self->{bodies}}) {
	$tle->rebless ();
    }

    return;

}

# _is_case_tolerant()
# Returns true if the OS supports case-tolerant file names. Yes, I know
# it's the file system that is important, but I don't have access to
# that level of detail.
{
    my %os = map { $_ => 1 } qw{ darwin };

    sub _is_case_tolerant {
	exists $os{$^O}
	    and return $os{$^O};
	return File::Spec->case_tolerant();
    }
}

#	_is_interactive()
#
#	Returns true if the dispatch() method is above us on the call
#	stack, otherwise returns false.

use constant INTERACTIVE_CALLER => __PACKAGE__ . '::dispatch';
sub _is_interactive {
    my $level = 0;
    while ( my @info = caller( $level ) ) {
	INTERACTIVE_CALLER eq $info[3]
	    and return $level;
	$level++;
    }
    return;
}

#	$self->_load_module ($module_name)

#	Loads the module if it has not yet been loaded. Dies if it
#	can not be loaded.

{	# Begin local symbol block

    my %version;
    BEGIN {
	%version = (
	    'Astro::SpaceTrack' => ASTRO_SPACETRACK_VERSION,
	);
    }

    sub _load_module {
	my ($self, @module) = @_;
	ARRAY_REF eq ref $module[0]
	    and @module = @{$module[0]};
	@module or $self->weep( 'No module specified' );
	my @probs;
	foreach my $module (@module) {
	    load_package ($module) or do {
		push @probs, "$module needed";
		next;
	    };
	    my $modver;
	    ($version{$module} && ($modver = $module->VERSION)) and do {
		$modver =~ s/_//g;
		$modver < $version{$module} and do {
		    push @probs,
		    "$module version $version{$module} needed";
		    next;
		};
	    };
	    return $module;
	}
	{
	    my $inx = 1;
	    while (my @clr = caller($inx++)) {
		$clr[3] eq '(eval)' and next;
		my @raw = split '::', $clr[3];
		substr ($raw[-1], 0, 1) eq '_' and next;
		push @probs, "for method $raw[-1]";
		last;
	    }
	}
	my $pfx = 'Error -';
	$self->wail(map {my $x = "$pfx $_\n"; $pfx = ' ' x 7; $x} @probs);
	return;	# Can't get here, but Perl::Critic does not know this.
    }

}	# end local symbol block.

#	$output = $self->_macro($name,@args)
#
#	Execute the named macro. The @args are of course optional.

sub _macro {
    my ($self, $name, @args) = @_;
    $self->{macro}{$name} or $self->wail("No such macro as '$name'");
    my $frames = $self->_frame_push(macro => [@args]);
    my $macro = $self->{frame}[-1]{macro}{$name} =
	delete $self->{macro}{$name};
    my $output;
    my $err;
    my $ok = eval {
	$output = $macro->execute( $name, @args );
	1;
    } or $err = $@;
    $self->_frame_pop($frames);
    $ok or $self->wail($err);
    return $output;
}

#	$angle = _parse_angle_parts ( @parts );
#
#	Joins parts of angles into an angle.
#	The @parts array is array references describing the parts in
#	decreasing significance, with [0] being the value, and [1] being
#	the number in the next larger part. For the first piece, [1]
#	should be the number in an entire circle.

sub _parse_angle_parts {
    my @parts = @_;
    my $angle = 0;
    my $circle = 1;
    my $places;
    foreach ( @parts ) {
	my ( $part, $size ) = @{ $_ };
	defined $part or last;
	$circle *= $size;
	$angle = $angle * $size + $part;
	$places = $part =~ m/ [.] ( [0-9]+ ) /smx ? length $1 : 0;
    }
    $angle *= 360 / $circle;
    if ( my $mag = sprintf '%d', $circle / 360 ) {
	$places += length $mag;
    }
    return sprintf( '%.*f', $places, $angle ) + 0;
}

# Documented in POD

sub __parse_angle {
    my ( $self, @args ) = @_;
    my $opt = HASH_REF eq ref $args[0] ? shift @args : {};
    my ( $angle ) = @args;
    defined $angle or return;

    if ( $angle =~ m/ : /smx ) {

	my ($h, $m, $s) = split ':', $angle;
	return _parse_angle_parts(
	    [ $h => 24 ],
	    [ $m => 60 ],
	    [ $s => 60 ],
	);

    } elsif ( $angle =~
	m{ \A ( [-+] )? ( [0-9]* ) d
	    ( [0-9]* (?: [.] [0-9]* )? ) (?: m
	    ( [0-9]* (?: [.] [0-9]* )? ) s? )? \z
	}smxi ) {
	my ( $sgn, $deg, $min, $sec ) = ( $1, $2, $3, $4 );
	$angle = _parse_angle_parts(
	    [ $deg => 360 ],
	    [ $min => 60 ],
	    [ $sec => 60 ],
	);
	$sgn and '-' eq $sgn and return -$angle;
	return $angle;
    }

    $opt->{accept}
	or looks_like_number( $angle )
	or $self->wail( "Invalid angle '$angle'" );

    return $angle;
}

# Documented in POD
{
    my %units = (
	au => AU,
	ft => 0.0003048,
	km => 1,
	ly => LIGHTYEAR,
	m => .001,
	mi => 1.609344,
	pc => PARSEC,
    );

    sub __parse_distance {
	my ($self, $string, $dfdist) = @_;
	defined $dfdist or $dfdist = 'km';
	my $dfunits = $dfdist =~ s/ ( [[:alpha:]]+ ) \z //smx ? $1 : 'km';
	my $units = lc (
	    $string =~ s/ \s* ( [[:alpha:]]+ ) \z //smx ? $1 : $dfunits );
	$units{$units}
	    or $self->wail( "Units of '$units' are unknown" );
	$string ne '' or $string = $dfdist;
	looks_like_number ($string)
	    or $self->wail( "'$string' is not a number" );
	return $string * $units{$units};
    }
}

# Documented in POD

sub __parse_time {
    my ($self, $time, $default) = @_;
    my $pt = $self->{time_parser}
	or $self->wail( 'No time parser available' );
    $self->{time_parser}->can( 'station' )
	and $self->_set_time_parser_attribute(
	station => $self->station() );
    if ( defined( my $time = $pt->parse( $time, $default ) ) ) {
	return $time;
    }
    $self->wail( "Invalid time '$time'" );
    return;
}

#	Reset the last time set. This is called from __arguments() in
#	::Utils if the invocant is an Astro::App::Satpass2.

sub __parse_time_reset {
    my ( $self ) = @_;
    defined ( my $pt = $self->{time_parser} )
	or return;
    $pt->reset();
    return;
}

#	$string = _rad2hms ($angle)

#	Converts the given angle in radians to hours, minutes, and
#	seconds (of right ascension, presumably)

sub _rad2hms {
    my $sec = shift;
    $sec *= 12 / PI;
    my $hr = floor( $sec );
    $sec = ( $sec - $hr ) * 60;
    my $min = floor( $sec );
    $sec = ( $sec - $min ) * 60;
    my $rslt = sprintf '%2d:%02d:%02d', $hr, $min, floor( $sec + .5 );
    return $rslt;
}

#	$line = $self->_read_continuation( $in, $error_message );
#
#	Acquire a line from $in, which must be a code reference taking
#	the prompt as an argument. If $in is not a code reference, or if
#	it returns undef, we wail() with the error message.  Otherwise
#	we return the line read. I expect this to be used only by
#	__tokenize().

sub _read_continuation {
    my ( $self, $in, $error ) = @_;
    $in and defined( my $more = $in->(
	    my $prompt = $self->get( 'continuation_prompt' ) ) )
	or do {
	    $error or return;
	    ref $error eq CODE_REF
		and return $error->();
	    $self->wail( $error );
	};
    $self->{echo} and $self->whinge( $prompt, $more );
    $more =~ m/ \n \z /smx or $more .= "\n";
    return $more;
}

# my ( $old_obj ) = $self->_replace_in_sky( $name, $new_obj );
# This is restricted to objects constructed via {sky_class}.
# The return is an array containing the replaced body, or nothing if
# the body was not found. The $new_obj is optional; if not provided a
# new object is created.
sub _replace_in_sky {
    my ( $self, $name, $new_obj ) = @_;
    $new_obj
	or $self->{sky_class}{ fold_case( $name ) }
	or $self->weep( "Can not replace $name; no class defined" );
    defined( my $inx = $self->_find_in_sky( $name ) )
	or return;
    return splice @{ $self->{sky} }, $inx, $inx + 1,
	$new_obj || $self->_sky_object( $name );
}

#	$self->_rewrite_level1_command( $buffer, $context );
#
#	This method rewrites a level1 command to its current form. The
#	arguments are the buffer containing the command, and an
#	initially-empty hash reference, which the method will use to
#	preserve context across lines of command. NOTE that more than
#	one rewritten command may be returned (e.g. 'almanac' into
#	( 'location', 'almanac' ).

{

    my %level1_map = (
	almanac	=> sub {
	    return ( 'location', $_[0] );
	},
	flare	=> sub {
	    local $_ = $_[0];
	    s/ (?<= \s ) - ( am|pm|day ) \b /-no$1/sxmg;
	    return $_;
	},
	pass	=> sub {
	    return ( 'location', $_[0] );
	},
    );

    my %level1_requote = (
	# In a macro definition:
	macro	=> {
	    # In single-quoted strings,
	    q{'}	=> sub {
		# escaped interpolations and double quotes may be
		# unescaped,
		s{ (?: \A | (?
		}{$1$2}sxmg;
		# and the string remains single-quoted.
		$_ = qq{'$_'};
		return;
	    },
	    # In double-quoted strings,
	    q{"}	=> sub {
		# escaped interpolations and double quotes may be
		# unescaped,
		s{ (?: \A | (?
		}{$1$2}sxmg;
		# unescaped single quotes become double quotes,
		s/ (?: \A | (?
		# and the string becomes single-quoted.
		$_ = qq{'$_'};
		return;
	    },
	},
	# Anywhere else
	''	=> {
	    # In single-quoted strings,
	    q{'}	=> sub {
		# unescaped double quotes must be escaped,
		s/ (?: \A | (?
		# escaped single quotes may be unescaped,
		s/ (?: \A | (?
		# and the string becomes double-quoted.
		$_ = qq{"$_"};
		return;
	    },
	    # In double-quoted strings,
	    q{"}	=> sub {
		# no changes need to be made.
		$_ = qq{"$_"};
		return;
	    },
	},
    );

    sub _rewrite_level1_command {
	my ( undef, $buffer, $context ) = @_;	# Invocant unused

	my $command = delete $context->{command};

	defined $buffer
	    or return $buffer;
	$buffer =~ m/ \A \s* \z /sxm
	    and return $buffer;
	$buffer =~ s/ \A \s* [#] 2 [#] \s* //sxm
	    and return $buffer;
	$buffer =~ m/ \A \s* [#] /sxm
	    and return $buffer;

	if ( ! defined $command ) {
	    $buffer =~ m/ \A \s* ( \w+ ) /sxm
		or return $buffer;
	    $command = $1;
	}
	my $append = '';
	$buffer =~ s/ ( \s* \\? \n ) //sxm
	    and $append = $1;
	$append =~ m/ \\ /sxm
	    and $context->{command} = $command;

	my $handler = $level1_requote{$command} || $level1_requote{''};
	my ( $this_quote, $start_pos );
	while ( $buffer =~ m/ (?: \A | (?
	) {
	    if ( ! defined $start_pos ) {
		$start_pos = $+[0] - 1;
		$this_quote = $1;
	    } elsif ( $1 eq $this_quote ) {
		my $length = $+[0] - $start_pos;
		local $_ = substr $buffer, $start_pos + 1, $length - 2;
		$handler->{$this_quote}->();
		substr $buffer, $start_pos, $length, $_;
		pos( $buffer ) = $start_pos + length $_;
		$start_pos = undef;
	    }
	}

	my $code = $level1_map{$command}
	    or return $buffer . $append;

	my @rslt = $code->( $buffer );
	$rslt[-1] .= $append;
	return @rslt;

    }
}

#	$self->_rewrite_level1_macros();
#
#	This method rewrites all macros defined by a satpass
#	initialization file (as opposed to a satpass2 initialization
#	file) to be satpass2-compatible. It also clears the level1 flag
#	so that the satpass-compatible functionality is not invoked.
#
#	Specifically it:
#	* Inserts a 'location' command before 'almanac' and 'pass';
#	* Changes the senses of the -am, -day, and -pm options in
#	  'flare';
#	* Removes delegated attributes from 'localize', replacing them
#	  with a localization of the helper object.
#
#	This method goes away when the satpass functionality does.

{
    my %helper_map = (
	date_format	=> {
	    helper	=> 'formatter',		# Helper obj attr. Req'd.
	},
	desired_equinox_dynamical	=> {
	    helper	=> 'formatter',
	},
	gmt		=> {
	    helper	=> 'formatter',
	},
	local_coord	=> {
	    helper	=> 'formatter',
	},
	time_format	=> {
	    helper	=> 'formatter',
	},
    );

    my %filter = (
	almanac	=> sub {
	    my ( undef, $line ) = @_;		# $verb unused
	    return ( 'location', $line );
	},
	flare	=> sub {
	    my ( undef, $line ) = @_;		# $verb unused
	    $line =~ s/ (?<= \s ) - (am|day|pm) \b /-no$1/smx;
	    return $line;
	},
	localize	=> sub {
	    my ( undef, $line ) = @_;		# $verb unused
	    my @things = split qr{ \s+ }smx, $line;
	    my @output;
	    my %duplicate;
	    foreach my $token ( @things ) {
		$helper_map{$token}
		    and $token = $helper_map{$token}{helper};
		$duplicate{$token}++ or push @output, $token;
	    }
	    return join ' ', @output;
	},
	pass	=> sub {
	    my ( undef, $line ) = @_;		# $verb unused
	    return ( 'location', $line );
	},
	set	=> sub {
	    my ( undef, $line ) = @_;		# $verb unused
	    my @output = [ 'fubar' ];	# Prime the pump.
	    my @input = Text::ParseWords::quotewords( qr{ \s+ }smx, 1,
		$line );
	    shift @input;
	    while ( @input ) {
		my ( $attr, $val ) = splice @input, 0, 2;
		if ( my $helper = $helper_map{$attr} ) {
		    push @output, [ $helper->{helper},
			# not quoter( $val ) here, because presumably it
			# is already quoted if it needs to be.
			$helper->{attribute} || $attr, $val ];
		} else {
		    'set' eq $output[-1][0]
			or push @output, [ 'set' ];
		    # not quoter( $val ) here, because presumably it is
		    # already quoted if it needs to be.
		    push @{ $output[-1] }, $attr, $val;
		}
	    }
	    shift @output;	# Get rid of the pump priming.
	    return ( map { join ' ', @{ $_ } } @output );
	},
	st	=> sub {
	    my ( undef, $line ) = @_;		# $verb unused
	    m/ \A \s* st \s+ localize \b /smx
		and return $line;
	    $line =~ s/ \b st \b /spacetrack/smx;
	    return $line;
	},
	show	=> sub {
	    my ( undef, $line ) = @_;		# $verb unused
	    my @output = [ 'fubar' ];
	    my @input = split qr{ \s+ }smx, $line;
	    shift @input;
	    foreach my $attr ( @input ) {
		if ( my $helper = $helper_map{$attr} ) {
		    push @output, [ $helper->{helper},
			$helper->{attribute} || $attr ];
		} else {
		    'show' eq $output[-1][0]
			or push @output, [ 'show' ];
		    push @{ $output[-1] }, $attr;
		}
	    }
	    shift @output;
	    return ( map { join ' ', @{ $_ } } @output );
	},
    );

    # Called by macro object's __level1_rewrite().
    sub __rewrite_level1_macro_def {
	my ( $self, $name, $args ) = @_;

	my ( $rewrote, @rslt );
	foreach ( @{ $args } ) {
	    if ( m/ ( \S+ ) /smx
		    and ( not $self->{macro}{$1}
			or $1 eq $name )
		    and my $code = $filter{$1} ) {
		push @rslt, $code->( $1, $_ );
		$rewrote++;
	    } else {
		push @rslt, $_;
	    }
	}

	return $rewrote ? \@rslt : $args;
    }

    sub _rewrite_level1_macros {
	my ( $self ) = @_;

	foreach my $macro ( values %{ $self->{macro} } ) {
	    $macro->__level1_rewrite();
	}

	return;
    }
}

#	@coordinates = $self->_simbad4 ($query)

#	Look up the given star in the SIMBAD catalog. This assumes
#	SIMBAD 4.

#	We die on any error.

sub _simbad4 {
    my $self = shift;
    $self->_load_module ('Astro::SIMBAD::Client');
    my $query = shift;
    my $simbad = Astro::SIMBAD::Client->new (
	format => {txt => 'FORMAT_TXT_SIMPLE_BASIC'},
	parser => {
	    script	=> 'Parse_TXT_Simple',
	    txt		=> 'Parse_TXT_Simple',
	},
	server => $self->{simbad_url},
	type => 'txt',
    );
    # I prefer script() to query() these days because the former does
    # not require SOAP::Lite, which seems to be getting flakier as time
    # goes on.
    # TODO get rid of $fmt =~ s/// once I massage
    # FORMAT_TXT_SIMPLE_BASIC in Astro::SIMBAD::Client
#   my @rslt = $simbad->query (id => $query)
    my $fmt = Astro::SIMBAD::Client->FORMAT_TXT_SIMPLE_BASIC();
    $fmt =~ s/ \n //smxg;
    my @rslt = $simbad->script( <<"EOD" )
format obj "$fmt"
query id $query
EOD
	or $self->wail("No entry found for $query");
    @rslt > 1
	and $self->wail("More than one entry found for $query");
    @rslt = map {$rslt[0]{$_} eq '~' ? 0 : $rslt[0]{$_} || 0} qw{
	ra dec plx pmra pmdec radial};
    ($rslt[0] && $rslt[1])
	or $self->wail("No position returned by $query");
    $rslt[2] = $rslt[2] ? 1000 / $rslt[2] : 10000;
    $rslt[3] and $rslt[3] /= 1000;
    $rslt[4] and $rslt[4] /= 1000;
    return wantarray ? @rslt : join ' ', @rslt;
}

sub _templates_to_options {
    my ( $self, $name, $opt ) = @_;
    $opt->{_template} = $name;
    my $code = sub {
	my ( $opt_name, $opt_value ) = @_;
	$opt->{_template} = $opt_value ? "${name}_$opt_name" : $name;
	return;
    };
    my $re = qr< \A \Q$name\E _ ( \w+ ) \z >smx;
    my @rslt;
    my $fmtr = $self->get( 'formatter' );
    if ( $fmtr->can( '__list_templates' ) ) {
	foreach ( $fmtr->__list_templates() ) {
	    $_ =~ $re
		or next;
	    push @rslt, "$1!", $code;
	}
    }
    return @rslt;
}

#	($tokens, $redirect) = $self->__tokenize(
#		{option => $value}, $buffer, [$arg0 ...]);
#
#	This method tokenizes the buffer. The options hash may be
#	omitted, in which case the $buffer to be tokenized is the first
#	argument. After the buffer is an optional reference to an array
#	of arguments to be substituted in.
#
#	This method attempts to parse and tokenize the buffer in a way
#	similar to the bash shell. That is, parameters are interpolated
#	inside double quotes but not single quotes, tilde expansion
#	takes place unless quoted, and spaces delimit tokens only when
#	occurring outside quotes.
#
#	The back slash character ('\') is an escape character. Inside
#	single quotes only the back slash itself and a single quote may
#	be escaped. Otherwise, anything can be escaped.
#
#	The returns are a reference to an array of tokens found, and a
#	reference to a hash of redirections found. This hash will have
#	zero or more of the keys '>' (standard output redirection) and
#	'<' (standard input redirection. The value of each key will be a
#	reference to a hash containing keys 'mode' ('>' or '>>' for
#	output, '<' or '<<' for input) and 'name' (normally the file
#	name).
#
#	The recognized options are:
#
#	    single => 1
#		causes the buffer to be interpreted as a single token.
#
#	    noredirect => 1
#		causes redirects to be illegal.
#
#	If noredirect is specified, only the $tokens reference is
#	returned. If noredirect and single are both specified, the
#	parsed and interpolated token is returned.
#
#	If interpolation is being done, an unescaped dollar sign
#	introduces the interpolation. This works pretty much the same
#	way as under bash: if the first character after the dollar sign
#	is a left curly bracket, everything to the corresponding right
#	curly bracked specifies the interpolation; if not, the rule is
#	that word characters specify the interpolation.
#
#	A number (i.e. $1) specifies interpolation of an argument.
#	Arguments are numbered starting at 1.
#
#	Otherwise, if the interpolation names an attribute, the value of
#	that attribute is interpolated in, otherwise the named
#	environment variable is interpolated in.
#
#	Most of the fancier forms of interpolation are suported. In the
#	following, word is expanded by recursively calling __tokenize
#	with options {single => 1, noredirect => 1}. But unlike bash, we
#	make no distinction between unset or null. The ':' can be
#	omitted before the '-', '=', '?' or '+', but it does not change
#	the functionality.
#
#	${parameter:-word} causes the given word to be substituted if
#	the parameter is undefined.
#
#	${parameter:=word} is the same as above, but also causes the
#	word to be assigned to the parameter if it is unassigned. Unlike
#	bash, this assignment takes place on positional parameters. If
#	done on an attribute or environment variable, it causes that
#	attribute or environment variable to be set to the given value.
#
#	${parameter:?word} causes the parse to fail with the error
#	'word' if the parameter is undefined.
#
#	${parameter:+word} causes the value of the given word to be used
#	if the parameter is defined, otherwise '' is used.
#
#	${parameter:offset} and ${parameter:offset:length} take
#	substrings of the parameter value. The offset and length must be
#	numeric.

{

    # Special variables.
    # Calling sequence: $special{$name}->(\@args, $relquote)
    my %special = (
	'0' => sub { return $0 },
	'#' => sub { return scalar @{ $_[0] } },
##	'*' => sub { return join ' ', @{ $_[0] } },
##	'@' => sub { return $_[1] ? join( ' ', @{ $_[0] } ) : $_[0] },
	'*' => sub { return $_[1] ? join( ' ', @{ $_[0] } ) : $_[0] },
	'@' => sub { return $_[0] },
	'$' => sub { return $$ },
	'_' => sub { return $^X },
    );

    my %case_ctl = (
	E	=> sub { delete $_[0]->{_case_mod} },
	F	=> sub { $_[0]->{_case_mod}{case} = sub { fold_case( $_[1] ) } },
	L	=> sub { $_[0]->{_case_mod}{case} = sub { lc $_[1] } },
	U	=> sub { $_[0]->{_case_mod}{case} = sub { uc $_[1] } },
	l	=> sub { $_[0]->{_case_mod}{single} = sub { lcfirst $_[1] } },
	u	=> sub { $_[0]->{_case_mod}{single} = sub { ucfirst $_[1] } },
    );

    # Leading punctuation that is equivalent to a method.
    my %command_equivalent = (
	'.'	=> 'source',
	'!' => 'system',
    );
    my $command_equiv_re = do {
	my $keys = join '', sort keys %command_equivalent;
	qr{ [$keys] }smx;
    };

    my %escape = (
	t	=> "\t",
	n	=> "\n",
	r	=> "\r",
	f	=> "\f",
	b	=> "\b",
	a	=> "\a",
	e	=> "\e",
    );

    sub __tokenize {
	my ($self, @parms) = @_;
	local $self->{_case_mod} = undef;
	my $opt = HASH_REF eq ref $parms[0] ? shift @parms : {};
	my $in = $opt->{in};
	my $buffer = shift @parms;
	$buffer =~ m/ \n \z /smx or $buffer .= "\n";
	my $args = shift @parms || [];
	my @rslt = ( {} );
	my $absquote;	# True if inside ''
	my $relquote;	# True if inside "" (and not in '')
	my $len = length $buffer;
	my $inx = 0;

	# Because I'm not smart enough to do all this with a regular
	# expression, I take the brute force approach and iterate
	# through the buffer to be tokenized. It's a 'while' rather than
	# a 'for' or 'foreach' because that way I get to muck around
	# with the current position inside the loop.

	while ($inx < $len) {
	    my $char = substr $buffer, $inx++, 1;

	    # If we're inside single quotes, the only escapable
	    # characters are single quote and back slash, and all
	    # characters until the next unescaped single quote go into
	    # the current token

	    if ( $absquote ) {
		if ( $char eq '\\' ) {
		    if ( (my $next = substr $buffer, $inx, 1) =~
			m/ ['\\] /smx ) {
			$inx++;
			$rslt[-1]{token} .= $next;
		    } else {
			$rslt[-1]{token} .= $char;
		    }
		} elsif ( $char eq q{'} ) {
		    $absquote = undef;
		} else {
		    $rslt[-1]{token} .= $char;
		    if ( $inx >= $len ) {
			$buffer .= $self->_read_continuation( $in,
			    'Unclosed single quote' );
			$len = length $buffer;
		    }
		}

	    # If we have a backslash, it escapes the next character,
	    # which goes on the current token no matter what it is.

	    } elsif ( $char eq '\\' ) {
		my $next = substr $buffer, $inx++, 1;
		if ( $inx >= $len ) {	# At end of line
		    if ( $relquote ) {	# Inside ""
			$buffer .= $self->_read_continuation( $in,
			    'Unclosed double quote' );
		    } else {		# Between tokens
			$buffer .= $self->_read_continuation( $in,
			    'Dangling continuation' );
			$opt->{single} or push @rslt, {};	# New token
		    }
		    $len = length $buffer;
		} elsif ( $relquote ) {
		    if ( my $code = $case_ctl{$next} ) {
			$code->( $self );
		    } else {
			$rslt[-1]{token} .= $escape{$next} || $next;
		    }
		} else {
		    $rslt[-1]{token} .= $next;
		}

	    # If we have a single quote and we're not inside double
	    # quotes, we go into absolute quote mode. We also append an
	    # empty string to the current token to force its value to be
	    # defined; otherwise empty quotes do not generate tokens.

	    } elsif ($char eq q{'} && !$relquote) {
		$rslt[-1]{token} .= '';	# Empty string, to force defined.
		$absquote++;

	    # If we have a double quote, we toggle relative quote mode.
	    # We also append an empty string to the current tokens for
	    # the reasons discussed above.

	    } elsif ($char eq '"') {
		$rslt[-1]{token} .= '';	# Empty string, to force defined.
		( $relquote = !$relquote )
		    or delete $self->{_case_mod};

	    # If we have a whitespace character and we're not inside
	    # quotes and not in single-token mode, we start a new token.
	    # It is possible that we generate redundant tokens this way,
	    # but the unused ones are eliminated later.

	    } elsif ($char =~ m/ \s /smx && !$relquote && !$opt->{single}) {
		push @rslt, {};

	    # If we have a dollar sign, it introduces parameter
	    # substitution, a non trivial endeavor.

	    } elsif ( $char eq '$' && $inx < $len ) {
		my $name = substr $buffer, $inx++, 1;
		my $brkt;

		# Names beginning with brackets are special. We note the
		# fact and scan for the matching close bracket, throwing
		# an exception if we do not have one.

		if ($name eq '{' && $inx < $len) {
		    $brkt = 1;
		    $name = '';
		    my $nest = 1;
		    while ($inx < $len) {
			$char = substr $buffer, $inx++, 1;
			if ($char eq '{') {
			    $nest++;
			} elsif ($char eq '}') {
			    --$nest or last;
			}
			$name .= $char;
		    }
		    $char eq '}'
			or $self->wail('Missing right curly bracket');

		# If the name begins with an alpha or an underscore, we
		# simply append any word ('\w') characters to it. If it
		# the word characters are immediately followed by a dot
		# and more word characters we grab them too, and advance
		# the current location past whatever we grabbed. The dot
		# syntax is in aid of accessing attributes of
		# attributes (e.g. $formatter.time_format)

		} elsif ( $name =~ m/ \A [[:alpha:]_] \z /smx ) {
		    pos( $buffer ) = $inx;
		    if ( $buffer =~ m/ \G ( \w* (?: [.] \w+ )? ) /smxgc ) {
			$name .= $1;
			$inx += length $1;
		    }
		}

		# Only bracketed names can be indirected, and then only
		# if the first character is a bang.

		my ($indirect, $value);
		$brkt and $indirect = $name =~ s/ \A ! //smx;

		# If we find a colon and/or one of the other cabbalistic
		# characters, we need to do some default processing.

		if ($name =~ m/ (.*?) ( [:]? [\-\+\=\?] | [:] ) (.*) /smx) {
		    my ($name, $flag, $rest) = ($1, $2, $3);

		    # First we do indirection if that was required.

		    $indirect
			and $name = $self->_tokenize_var(
			    $name, $args, $relquote, $indirect);

		    # Next we find out whether we have an honest-to-God
		    # colon, since that might specify substring
		    # processing.

##		    my $colon = $flag =~ s/ \A : //smx ? ':' : '';
		    $flag =~ s/ \A : //smx;

		    # We run the stuff after the first cabbalistic
		    # character through the tokenizer, since further
		    # expansion is possible here.

		    my $mod = __tokenize(
			$self,
			{ single => 1, noredirect => 1, in => $in },
			$rest, $args);
		    chomp $mod;	# Don't want trailing \n here.

		    # At long last we get the actual value of the
		    # variable. This will be either undef, a scalar, or
		    # a list reference.

		    $value = $self->_tokenize_var(
			$name, $args, $relquote);

		    # The value is logically defined if it is a scalar
		    # and not undef, or if it is an array reference and
		    # the array is not empty.

		    my $defined = ref $value ? @$value : defined $value;

		    # The '+' cabbalistic sign replaces the value of the
		    # variable if it is logically defined.

		    if ($flag eq '+') {
			$value = $defined ? $mod : '';

		    # If the variable is defined, only substring
		    # processing is possible. This actually is
		    # implemented as slice processing if the value is an
		    # array reference.

		    } elsif ($defined) {
			if ($flag eq '') {
			    my @pos = split ':', $mod, 2;
			    foreach ( @pos ) {
				s/ \A \s+ //smx;
			    }
			    @pos > 2
				and $self->wail(
				'Substring expansion has extra arguments' );
			    foreach ( @pos ) {
				m/ \A [-+]? [0-9]+ \z /smx
				    or $self->wail(
				    'Substring expansion argument non-numeric'
				);
			    }
			    if (ref $value) {
				if (@pos > 1) {
				    $pos[1] += $pos[0] - 1;
				} else {
				    $pos[1] = $#$args;
				}
				$pos[1] > $#$value and $pos[1] = $#$value;
				$value = [@$value[$pos[0] .. $pos[1]]];
			    } else {
				# We want to disable warnings if we slop
				# outside the string.
				no warnings qw{substr};
				$value = @pos == 1 ? substr $value, $pos[0] :
				    substr $value, $pos[0], $pos[1];
			    }
			}

		    # If the cabbalistic sign is '-', we supply the
		    # remainder of the specification as the default.

		    } elsif ($flag eq '-') {
			$value = $mod;

		    # If the cabbalistic sign is '=', we supply the
		    # remainder of the specification as the default. We
		    # also set the variable to the value, for future
		    # use. Note that special variables may not be set,
		    # and result in an exception.

		    } elsif ($flag eq '=') {
			$value = $mod;
			if ( $special{$name} || $name !~ m/ \D /smx ) {
			    $self->wail("Cannot assign to \$$name");
##			} elsif ($name !~ m/\D/) {
##			    $args->[$name - 1] = $value;
			} elsif (exists $mutator{$name}) {
			    $self->set($name => $value);
			} else {
			    $self->{frame}[-1]{define}{$name} = $value;
			}

		    # If the cabbalistic sign is '?', we throw an
		    # exception with the remainder of the specification
		    # as the text.

		    } elsif ($flag eq '?') {
			$self->wail($mod);

		    # If there is no cabbalistic sign at all, we fell
		    # through here trying to do substring expansion on
		    # an undefined variable. Since Bash allows this, we
		    # will to, though with misgivings.

		    } elsif ( $flag eq '' ) {
			$value = '';

		    # Given the way the parser works, the above should
		    # have exhausted all possibilities. But being a
		    # cautious programmer ...

		    } else {
			$self->weep(
			    "\$flag = '$flag'. This should not happen"
			);
		    }

		# Without any cabbalistic signs, variable expansion is
		# easy. We perform the indirection if needed, and then
		# grab the value of the variable, which still can be
		# undef, a scalar, or an array reference.

		} else {
		    $indirect
			and $name = $self->_tokenize_var(
			$name, $args, $relquote, $indirect);
		    $value = $self->_tokenize_var(
			$name, $args, $relquote);
		}

		# For simplicity in what follows, make the value into an
		# array reference.
		ref $value
		    or $value = defined $value ? [ $value ] : [];

		# If we are inside quotes
		if ( $relquote ) {
		    # do case modification
		    # NOTE that the argument list is modified in-place.
		    $self->_case_mod( @{ $value } );
		} else {
		    # otherwise do word splitting
		    $value = [ map { split qr{ \s+ }smx } @{ $value } ];
		}

		# If we have a value, append each element to the current
		# token, and then create a new token for the next
		# element. The last element's empty token gets
		# discarded, since we may need to append more data to
		# the last element (e.g.  "$@ foo").
		if ( @{ $value } ) {
		    foreach ( @$value ) {
			$rslt[-1]{token} .= $_;
			push @rslt, {};
		    }
		    pop @rslt;
		}

		# Here ends the variable expansion code.

	    # If the character is an angle bracket or a pipe, we have a
	    # redirect specification. This always starts a new token. We
	    # flag the token as a redirect, stuff all matching
	    # characters into the mode (throwing an exception if there
	    # are too many), consume any trailing spaces, and set the
	    # token value to the empty string to prevent executing this
	    # code again when we hit the first character of the file
	    # name. Note that redirect tokens always get tilde
	    # expansion.

	    } elsif ( $char =~ m/ [<>|] /smx ) {
		push @rslt, {
		    redirect => 1,
		    type => ($char eq '<' ? '<' : '>'),
		    mode => ($char eq '|' ? '|-' : $char),
		    expand => ($char ne '|')
		};
		while ($inx < $len) {
		    my $next = substr $buffer, $inx++, 1;
		    $next =~ m/ \s /smx and next;
		    if ($next eq $char) {
			$rslt[-1]{mode} .= $next;
			length $rslt[-1]{mode} > 2
			    and $self->wail(
			    "Syntax error near $rslt[-1]{mode}");
		    } else {
			--$inx;
			$rslt[-1]{token} = '';
			last;
		    }
		}
		if ( '<<' eq $rslt[-1]{mode} ) {	# Heredoc
		    delete $rslt[-1]{redirect};
		    delete $rslt[-1]{type};
		    delete $rslt[-1]{mode};
		    my $quote = '';
		    while ( $inx < $len ) {
			my $next = substr $buffer, $inx++, 1;
			if ( $next =~ m/ \s /smx ) {
			    $quote or last;
			    $rslt[-1]{token} .= $next;
			} else {
			    '' eq $rslt[-1]{token}
				and $next =~ m/ ['"] /smx
				and $quote = $next
				or $rslt[-1]{token} .= $next;
			    $quote
				and $next eq $quote
				and $rslt[-1]{token} ne ''
				and last;
			}
		    }
		    $quote and $rslt[-1]{token} =~ s/ . \z //sxm;
		    my $terminator = $rslt[-1]{token};
		    my $look_for = $terminator . "\n";
		    $rslt[-1]{token} = '';
		    $rslt[-1]{expand} = $quote ne q<'>;
		    while ( 1 ) {
			my $buffer = $self->_read_continuation( $in,
			    "Here doc terminator $terminator not found" );
			$buffer eq $look_for and last;
			$rslt[-1]{token} .= $buffer;
		    }
		    if ( $quote ne q<'> ) {
			$rslt[-1]{token} = __tokenize(
			    $self,
			    { single => 1, noredirect => 1, in => $in },
			    $rslt[-1]{token}, $args
			);
		    }
		    push @rslt, {};	# New token
		}

	    # If the token already exists at this point, the current
	    # character, whatever it is, is simply appended to it.

	    } elsif (exists $rslt[-1]{token} || $relquote) {
		# do case modification
		# NOTE that the argument list is modified in-place.
		$self->_case_mod( $char );
		$rslt[-1]{token} .= $char;

	    # If the character is a tilde, we flag the token for tilde
	    # expansion.

	    } elsif ($char eq '~') {
		$rslt[-1]{tilde}++;
		$rslt[-1]{token} .= $char;

	    # If the character is a hash mark, it means a comment. Bail
	    # out of the loop.
	    } elsif ( $char eq '#' ) {
		last;

	    # Else we just put it in the token.
	    } else {
		$rslt[-1]{token} .= $char;
	    }

	    # If we're at the end of the buffer but we're inside quotes,
	    # we need to read another line.
	    if ( $inx >= $len && ( $absquote || $relquote ) ) {
		$buffer .= $self->_read_continuation( $in,
		    $absquote ? 'Unclosed single quote' :
			'Unclosed double quote'
		);
		$len = length $buffer;
	    }

	}

	# We have run through the entire string to be tokenized. If
	# there are unclosed quotes of either sort, we declare an error
	# here. This should actually not happen, since we allow
	# multi-line quotes, and if we have run out of input we catch it
	# above.

	$absquote and $self->wail( 'Unclosed terminal single quote' );
	$relquote and $self->wail( 'Unclosed terminal double quote' );

	# Replace leading punctuation with the corresponding method.

	shift @rslt
	    while @rslt && ! defined $rslt[0]{token};
	if ( defined $rslt[0]{token} and
		$rslt[0]{token} =~ s/ \A ( $command_equiv_re ) //smx ) {
	    if ( $rslt[0]{token} eq '' ) {
		$rslt[0]{token} = $command_equivalent{$1};
	    } elsif ( $opt->{single} ) {
		$rslt[0]{token} = join ' ', $command_equivalent{$1},
		    $rslt[0]{token};
	    } else {
		unshift @rslt, {
		    token	=> $command_equivalent{$1},
		};
	    }
	}

	# Go through our prospective tokens, keeping only those that
	# were actually defined, and shuffling the redirects off into
	# the redirect hash.

	my (@tokens, %redir);
	my $expand_tildes = 1;
	if ( defined $rslt[0]{token}
		and my $kode = $self->can( $rslt[0]{token} ) ) {
	    if ( my $hash = $self->__get_attr( $kode, 'Tokenize' ) ) {
		$expand_tildes = $hash->{expand_tilde};
	    }
	}
	foreach (@rslt) {
	    exists $_->{token} or next;
	    if ($_->{redirect}) {
		if ( $_->{mode} eq '<' ) {
		    push @tokens, $self->_file_reader(
			$_->{token}, { glob => 1 } );
		} else {
		    my $type = $_->{type};
		    $redir{$type} = {
			mode => $_->{mode},
			name => ($_->{expand} ?
			    $self->expand_tilde($_->{token}) :
			    $_->{token}),
		    };
		}
	    } elsif ( $expand_tildes && $_->{tilde} ) {
		push @tokens, $self->expand_tilde( $_->{token} );
	    } else {
		push @tokens, $_->{token};
	    }
	}

	# With the {single} and {noredirect} options both asserted,
	# there is only one token, so we return it directly.

	($opt->{single} && $opt->{noredirect}) and return $tokens[0];

	# With the {noredirect} option asserted, we just return a
	# reference to the tokens found.

	$opt->{noredirect} and return \@tokens;

	# Otherwise we return a list, with a reference to the token list
	# as the first element, and a reference to the redirect hash as
	# the second element.

	return (\@tokens, \%redir);
    }

    # Retrieve the value of a variable.
    sub _tokenize_var {
	my ($self, $name, $args, $relquote, $indirect) = @_;

	defined $name and $name ne ''
	    or return $indirect ? '' : undef;

	$special{$name} and do {
	    my $val = $special{$name}->($args, $relquote);
	    return ($indirect && ref $val) ? '' : $val;
	};

	$name !~ m/ \D /smx
	    and return $args->[$name - 1];

	my $value = $self->_attribute_value( $name );
	NULL_REF eq ref $value
	    or return $value;

	exists $self->{exported}{$name}
	    and return $self->{exported}{$name};

	defined $ENV{$name}
	    and return $ENV{$name};

	foreach my $frame ( reverse @{ $self->{frame} } ) {
	    defined $frame->{define}{$name}
		and return $frame->{define}{$name};
	}

	return;
    }

}

# Apply case modification to the arguments
# NOTE that the argument list is modified in-place. I'm a little
# surprised that this didn't tickle Perl::Critic.
sub _case_mod {
    my $self = shift;
    foreach ( @_ ) {
	$self->{_case_mod}{case}
	    and $_ = $self->{_case_mod}{case}->( $self, $_ );
	my $code;
	$code = delete $self->{_case_mod}{single}
	    and $_ = $code->( $self, $_ );
    }
    return;
}

#	$self->wail(...)
#
#	Either die or croak with the arguments, depending on the value
#	of the 'warning' attribute. If we die, a trailing period and
#	newline are provided if necessary. If we croak, any trailing
#	punctuation and newline are stripped.

sub wail {
    my ($self, @args) = @_;
    $self->{_warner}->wail( @args );
    return;	# We can't hit this, but Perl::Critic does not know that.
}

#	$self->__wail(...)
#
#	either wail() or whinge() depending on error_out.
sub __wail {
    my ($self, @args) = @_;
    if ( $self->get( 'error_out' ) ) {
	$self->{_warner}->wail( @args );
    } else {
	$self->{_warner}->whinge( @args );
    }
    return;
}

#	$self->weep(...)
#
#	Die with a stack dump (Carp::confess).

sub weep {
    my ($self, @args) = @_;
    $self->{_warner}->weep( @args );
    return;	# We can't hit this, but Perl::Critic does not know that.
}

#	$self->whinge(...)
#
#	Either warn or carp with the arguments, depending on the value
#	of the 'warn' attribute. If we warn, a trailing period and
#	newline are provided if necessary. If we carp, any trailing
#	punctuation and newline are stripped.

sub whinge {
    my ($self, @args) = @_;
    $self->{_warner}->whinge( @args );
    return;
}

1;

__END__