File Coverage

blib/lib/Astro/App/Satpass2/FormatValue.pm

Criterion	Covered	Total	%
statement	547	583	93.8
branch	238	338	70.4
condition	83	151	54.9
subroutine	92	98	93.8
pod	20	20	100.0
total	980	1190	82.3

package Astro::App::Satpass2::FormatValue;

use strict;
use warnings;

use parent qw{ Astro::App::Satpass2::Copier };

use Astro::App::Satpass2::FormatTime;
use Astro::App::Satpass2::FormatValue::Formatter;
use Astro::App::Satpass2::Locale qw{ __localize };
use Astro::App::Satpass2::Utils qw{
    has_method instance merge_hashes
    ARRAY_REF CODE_REF HASH_REF
    @CARP_NOT
};
use Astro::App::Satpass2::Warner;
use Astro::Coord::ECI::Sun 0.059;
use Astro::Coord::ECI::TLE 0.059 qw{ :constants };
use Astro::Coord::ECI::Utils 0.059 qw{ deg2rad embodies julianday PI rad2deg TWOPI };
use Clone ();
use List::Util qw{ max min };
use POSIX qw{ floor };
use Scalar::Util 1.26 qw{ isdual reftype };
use Text::Wrap ();

our $VERSION = '0.051';

use constant NONE => undef;
use constant RE_ALL_DIGITS	=> qr{ \A [0-9]+ \z }smx;
use constant TITLE_GRAVITY_BOTTOM	=> 'bottom';
use constant TITLE_GRAVITY_TOP		=> 'top';

#	Instantiator

{

    sub new {
	my ( $class, %args ) = @_;
	ref $class and $class = ref $class;
	my $self = {};
	bless $self, $class;

	$self->warner( delete $args{warner} );

	foreach my $name ( qw{ data default } ) {
	    $self->{$name} = $args{$name} || {};
	    ref $self->{$name}
		and HASH_REF eq reftype( $self->{$name} )
		or $self->{warner}->wail(
		"Argument '$name' must be a hash reference" );
	}

	$self->{desired_equinox_dynamical} =
	    $args{desired_equinox_dynamical} || 0;

	$self->{fixed_width} = exists $args{fixed_width} ?
	    $args{fixed_width} :
	    1;

	$self->{overflow} = $args{overflow} || 0;

	defined( $self->{local_coordinates} = $args{local_coordinates} )
	    or $self->{local_coordinates} = \&__local_coord_azel_rng;
	ref $self->{local_coordinates}
	    or $self->{local_coordinates} = $self->can(
		"__local_coord_$self->{local_coordinates}" )
	    or $self->{warner}->wail(
		"Unknown local_coordinates $self->{local_coordinates}" );
	CODE_REF eq ref $self->{local_coordinates}
	    or $self->{warner}->wail(
		'Argument local_coordinates must be a code reference ',
		'or the name of a known coordinate system'
	    );

	defined( $self->{list_formatter} = $args{list_formatter} )
	    or $self->{list_formatter} = $self->can( '__list_formatter' );
	CODE_REF eq ref $self->{list_formatter}
	    or $self->{warner}->wail(
		'Argument list_formatter must be a code reference ',
		'or the name of a known coordinate system'
	    );

	$self->{title} = $args{title};

	$self->title_gravity( _dor( $args{title_gravity},
		TITLE_GRAVITY_TOP ) );

	$self->{time_formatter} = $args{time_formatter} ||
	    'Astro::App::Satpass2::FormatTime';
	ref $self->{time_formatter}
	    or $self->{time_formatter} = $self->{time_formatter}->new();
	instance( $self->{time_formatter},
	    'Astro::App::Satpass2::FormatTime' )
	    or $self->{warner}->wail(
	    'Argument time_formatter must be an Astro::App::Satpass2::FormatTime'
	);
	$self->{date_format} = $args{date_format};
	defined $self->{date_format}
	    or $self->{date_format} = $self->{time_formatter}->DATE_FORMAT();
	$self->{time_format} = $args{time_format};
	defined $self->{time_format}
	    or $self->{time_format} = $self->{time_formatter}->TIME_FORMAT();
	if ( exists $args{round_time} ) {
	    $self->{round_time} = $args{round_time};
	} else {
	    $self->{round_time} = $self->{time_formatter}->ROUND_TIME();
	}

	$self->{report} = $args{report};

	return $self;
    }

}

#	Overrides

sub clone {
    my ( $self, @args ) = @_;
    my %arg;
    if ( @args == 1 && HASH_REF eq ref $args[0] ) {
	%arg = %{ $args[0] };
    } else {
	%arg = @args;
    }
    foreach my $name ( keys %{ $self } ) {
	defined $arg{$name}
	    or $arg{$name} = $self->{ $name };
    }
    delete $arg{internal};
    return $self->new( %arg );
}

#	Accessors.

sub body {	# Required for template 'list', which needs to figure
		# out whether the body is inertial or not.
    my ( $self ) = @_;
    return $self->_get_eci( 'body' );
}

sub data {
    my ( $self ) = @_;
    return $self->_get( 'data' );
}

#	Mutators. These should be kept to a minimum.

sub fixed_width {
    my ( $self, @args ) = @_;
    if ( @args ) {
	$self->{fixed_width} = $args[0];
	return $self;
    } else {
	return $self->{fixed_width};
    }
}

sub title_gravity {
    my ( $self, @args ) = @_;
    if ( @args ) {
	is_valid_title_gravity( $args[0] )
	    or $self->{warner}->wail(
		"Attribute title_gravity value '$args[0]' invalid"
	    );
	$self->{title_gravity} = $args[0];
	return $self;
    } else {
	return $self->{title_gravity};
    }
}

#	Transformations

sub appulse {
    my ( $self ) = @_;
    return $self->_variant( 'appulse' );
}

sub bodies {
    my ( $self ) = @_;
    my $bodies = $self->_get( data => 'bodies' )
	or return;

    my $questionable = $self->_get( data => 'questionable' );
    my $sta = $self->_get( data => 'station' );
    my $time = $self->_get( data => 'time' );
    my $twilight = $self->_get( data => 'twilight' );
    defined $twilight
	or $twilight = deg2rad( -6 );	# Civil

    my @rslt;
    foreach my $body ( @{ $bodies } ) {
	embodies( $body, 'Astro::Coord::ECI' )
	    or next;

	my $data = {
	    body		=> $body,
	    illumination	=> _illumination(
		body	=> $body,
		station	=> $sta,
		time	=> $time,
		twilight => $twilight,
	    ),
	    questionable	=> $questionable,
	};

	push @rslt, $self->_variant( $data );
    }

    return \@rslt;
}

sub _elevation {
    my ( $station, $body, $time ) = @_;
    defined $time and $body->universal( $time );
    return ( $station->azel( $body ) )[1];
}

sub _illumination {
    my %arg = @_;

    embodies( $arg{body}, 'Astro::Coord::ECI::TLE' )
	or return PASS_EVENT_NONE;

    defined $arg{time}
	or $arg{time} = $arg{body}->universal();

    embodies( $arg{sun}, 'Astro::Coord::ECI' )
	or $arg{sun} = $arg{body}->get( 'sun' );
    embodies( $arg{sun}, 'Astro::Coord::ECI' )
	or $arg{sun} = Astro::Coord::ECI::Sun->new();

    defined $arg{twilight}
	or $arg{twilight} = _dor(
	    $arg{body}->get( 'twilight' ),
	    deg2rad( -6 ),	# Civil
	);

    defined $arg{time}
	and embodies( $arg{station}, 'Astro::Coord::ECI' )
#	and _elevation( $arg{station}, $arg{body}, $arg{time} ) >= 0
	or return PASS_EVENT_NONE;

    $arg{body}->illuminated( $arg{time} )
	or return PASS_EVENT_SHADOWED;

    _elevation( $arg{station}, $arg{sun}, $arg{time} ) > $arg{twilight}
	and _elevation( $arg{station}, $arg{body}, $arg{time} ) >= 0
	and return PASS_EVENT_DAY;

    return PASS_EVENT_LIT;
}

sub center {
    my ( $self ) = @_;
    return $self->_variant( 'center' );
}

sub earth {
    my ( $self ) = @_;
    my $earth = $self->_variant();
    $earth->{data}{station} = Astro::Coord::ECI->new()->ecef( 0, 0, 0 );
    return $earth;
}

sub events {
    my ( $self ) = @_;
    return [ map { $self->clone( data => $_ ) } $self->__raw_events() ];
}

sub tle_events {
    my ( $self ) = @_;
    my @rslt;

    foreach my $evt ( $self->__raw_events() ) {
	embodies( $evt->{body}, 'Astro::Coord::ECI::TLE' )
	    or next;
	push @rslt, $self->clone( data => $evt );
    }
    return \@rslt;
}

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

    my $events = $self->_get( data => 'events' )
	or return;

    ARRAY_REF eq ref $events
	or return;

    return @{ $events };
}

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

    my $body = $self->_get_tle( 'body' )
	or return;

    my $sta = $self->_get_eci( 'station' )
	or return;

    my $time = $self->_get( data => 'time' );
    defined $time
	or $time = $body->universal();
    defined $time or return;

    my $illum = $self->_get( data => 'illumination' );
    defined $illum
	or $illum = _illumination(
	    body	=> $body,
	    station	=> $sta,
	    time	=> $time,
	);

    $illum
	and ( PASS_EVENT_LIT == $illum
	    or PASS_EVENT_DAY == $illum )
	and $body->can_flare( $self->_get( data => 'questionable' ) )
	or return;

    $body->set( horizon => 0 );
    my @rslt;
    foreach my $info ( $body->reflection( $sta, $time ) ) {
	push @rslt, $self->_variant( $info );
    }

    return \@rslt;
}

sub station {
    my ( $self ) = @_;
    my $station = $self->_variant();
    ( $station->{data}{body}, $station->{data}{station} ) = (
	map { $station->_get( data => $_ ) } qw{ station body } );
    return $station;
}

#	Formatters

sub list {
    my ( $self, %arg ) = _arguments( @_ );
    return $self->{list_formatter}->( $self, %arg );
}

sub __list_formatter {
    my ( $self, @arg ) = _arguments( @_ );
    my $body;
    my $type = ( $body = $self->body() ) ?
	$body->__list_type() :
	'inertial';
    my $code;
    $code = $self->can( "__list_formatter_$type" )
	and return $code->( $self, @arg );
    $code = $self->can( "__list_formatter_args_$type" ) ||
	$self->can( '__list_formatter_args_inertial' );
    my $rslt = join ' ', map { $self->$_( @arg ) } $code->( $self );
    $rslt =~ s/ \s+ \z //smx;
    return $rslt;
}

sub __list_formatter_args_fixed {
    return ( qw{ oid name latitude longitude altitude } );
}

sub __list_formatter_args_inertial {
    return ( qw{ oid name epoch period } );
}

sub local_coord {
    my ( $self, %arg ) = _arguments( @_ );
    return $self->{local_coordinates}->( $self, %arg );
}

sub __local_coord_az_rng {
    my ( $self, @arg ) = _arguments( @_ );
    return join ' ', $self->azimuth( @arg, { bearing => 2 } ),
	$self->range( @arg );
}

sub __local_coord_azel {
    my ( $self, @arg ) = _arguments( @_ );
    return join ' ', $self->elevation( @arg ),
	$self->azimuth( @arg, { bearing => 2 } );
}

sub __local_coord_azel_rng {
    my ( $self, @arg ) = _arguments( @_ );
    return join ' ', $self->elevation( @arg ),
	$self->azimuth( @arg, { bearing => 2 } ),
	$self->range( @arg );
}

sub __local_coord_equatorial {
    my ( $self, @arg ) = _arguments( @_ );
    return join ' ', $self->right_ascension( @arg ),
	$self->declination( @arg );
}

sub __local_coord_equatorial_rng {
    my ( $self, @arg ) = _arguments( @_ );
    return join ' ', $self->right_ascension( @arg ),
	$self->declination( @arg ),
	$self->range( @arg );
}

#	The %dimensions hash defines physical dimensions and the
#	allowable units for each. The keys of this hash are the names of
#	physical dimensions (e.g. 'length', 'mass', 'volume', and so
#	on), and the values are hashes defining the dimension.
#
#	Each dimension definition hash must have the following keys:
#
#	align_left => boolean
#	    This optional key, if true, specifies that the value is to
#	    be aligned to the left in its field. This value can be
#	    overridden in the {define} key, or when the formatter is
#	    called.
#
#	default => the name of the default units for the dimension. This
#	    value must appear as a key in the define hash (see below).
#	    This default can be overridden by a given format effector.
#
#	define => a hash defining the legal units for the dimension. The
#	    keys are the names of the units (e.g. for length
#	    'kilometers', 'meters', 'miles', 'feet'). The value is a
#	    hash containing zero or more of the following keys:
#
#	    alias => name
#	        This optional key specifies that the name is just an
#	        alias for another key, which must exist in the define
#	        hash. No other keys need be specified.
#
#	    align_left => boolean
#		This optional key, if true, specifies that the value is
#		to be aligned to the left of its field. It can be
#		overridden by a value specified when the formatter is
#		called.
#
#	    factor => number
#		A number to multiply the value by to do the conversion.
#
#	    formatter => name
#		This optional key specifies the name of the formatter
#		routine to use instead of the normal one.
#
#	    method => _name
#		This optional key specifies a method to call. The method
#		is passed the value being formatted, and the method's
#		return becomes the new value to format. If both {factor}
#		and {method} are specified, {method} is done first.
#
#	formatter => name
#	    This key specifies the formatter to use for the units. It
#	    can be overridden in the {define} key.

my %dimensions = (

    almanac_pseudo_units	=> {
	default	=> 'description',
	define	=> {
	    event	=> {},
	    detail	=> {
		formatter	=> '_format_integer',
	    },
	    description	=> {},
	},
	formatter	=> '_format_string',
    },

    angle_units => {
	align_left	=> 0,
	default		=> 'degrees',
	define	=> {
	    bearing	=> {
		align_left	=> 1,
		formatter	=> '_format_bearing',
	    },
	    decimal	=> {
		alias		=> 'degrees',
	    },
	    degrees	=> {
		factor		=> 90/atan2( 1, 0 ),
	    },
	    radians	=> {},
	    phase	=> {
		align_left	=> 1,
		formatter	=> '_format_phase',
	    },
	    right_ascension	=> {
		formatter	=> '_format_right_ascension',
	    },
	},
	formatter	=> '_format_number',
    },

    dimensionless	=> {
	default		=> 'unity',
	define		=> {
	    percent	=> {
		factor	=> 100,
	    },
	    unity	=> {},
	},
	formatter	=> '_format_number',
    },

    duration => {
	default		=> 'composite',
	define => {
	    composite	=> {
		formatter	=> '_format_duration',
	    },
	    seconds	=> {},
	    minutes	=> {
		factor	=> 1/60,
	    },
	    hours	=> {
		factor	=> 1/3600,
	    },
	    days	=> {
		factor	=> 1/86400,
	    },
	},
	formatter	=> '_format_number',
    },

    event_pseudo_units	=> {
	default	=> 'localized',
	define	=> {
	    localized	=> {},
	    integer	=> {
		formatter	=> '_format_integer',
	    },
	    string	=> {},
	},
	formatter	=> '_format_event',
    },

    integer_pseudo_units	=> {
	align_left	=> 0,
	default	=> 'integer',
	define	=> {
	    integer	=> {},
	},
	formatter	=> '_format_integer',
    },

    length => {
	align_left	=> 0,
	default		=> 'kilometers',
	define	=> {
	    kilometers	=> {},
	    km		=> {},
	    meters	=> {
		factor		=> 1000,
	    },
	    m		=> {
		alias		=> 'meters',
	    },
	    miles	=> {
		factor		=> 0.62137119,
	    },
	    mi		=> {
		alias		=> 'miles',
	    },
	    feet	=> {
		factor		=> 3280.8399,
	    },
	    ft		=> {
		alias		=> 'feet',
	    },
	},
	formatter	=> '_format_number',
    },

    number	=> {	# Just for consistency's sake
	align_left	=> 0,
	default		=> 'number',
	define		=> {
	    number	=> {},
	},
	formatter	=> '_format_number',
    },

    scientific	=> {	# Just for consistency's sake
	align_left	=> 0,
	default		=> 'scientific',
	define		=> {
	    scientific	=> {},
	},
	formatter	=> '_format_number_scientific',
    },

    string	=> {	# for tle, to prevent munging data. ONLY
			# 'string' is to be defined.
	default	=> 'string',
	define	=> {
	    string	=> {},
	},
	formatter	=> '_format_string',
    },

    string_pseudo_units	=> {
	default	=> 'string',
	define	=> {
	    lower_case	=> {
		formatter	=> '_format_lower_case',
	    },
	    string	=> {},
	    title_case	=> {
		formatter	=> '_format_title_case',
	    },
	    upper_case	=> {
		formatter	=> '_format_upper_case',
	    },
	},
	formatter	=> '_format_string',
    },

    time_units => {
	default		=> 'local',
	define	=> {
	    days_since_epoch => {
		factor	=> 1/86400,
		formatter => '_format_number',
		method	=> '_subtract_epoch',
	    },
	    gmt		=> {
		gmt	=> 1,
	    },
	    julian	=> {
		formatter	=> '_format_number',
		method		=> '_julian_day',
	    },
	    local	=> {},
	    universal	=> {
		alias	=> 'gmt',
	    },
	    z		=> {
		alias	=> 'gmt',
	    },
	    zulu	=> {
		alias	=> 'gmt',
	    },
	},
	formatter	=> '_format_time',
    },

);

# The following was for a utility script to generate documentation for
# the dimensions.
#
# sub __get_dimension_data {
#     my ( $class, $name ) = @_;
#     return $dimensions{$name};
# }

#	The following hash is used for generating formatter methods, as
#	a way of avoiding the replication of common code. The keys are
#	the method names, and the values are hashes which specify the
#	method to generate. If the named method already exists, it is
#	not replaced.
#
#	The hash specifying each method contains the following keys,
#	which are all requited unless the documentation for the key says
#	otherwise.
#
#	{chain} - An optional code reference which may (but need not)
#	    expand the formatter to produce multiple representations of
#	    the same value. It takes the arguments ( $self, $name,
#	    $value, $arg ) where $self is the invocant, $name is the
#	    name of the formatter method, $value is the value being
#	    formatted, and $arg is the formatter arguments, which have
#	    already had the defaults applied. It returns at least one
#	    argument hash. If it returns more than one, the same value
#	    is formatted using each set of arguments, with the results
#	    made into a single string using join( ' ', ... ). The
#	    returned argument sets MUST keep the same field width for
#	    the same arguments.
#
#	    This is used only for azimuth(), to process the 'bearing'
#	    argument.
#
#	{default} - A hash specifying all legal arguments, and their
#	    default values. You can specify undef to make the argument
#	    legal but give it no value (i.e. to pick up the value from
#	    somewhere else).
#
#	{dimension} - A hash specifying the dimension of the value to be
#	    formatted. This must contain a {dimension} key specifying
#	    the name of the dimension, and may contain a {units} value
#	    overriding the default units.
#
#	{fetch} - A code reference which returns the value to be
#	    formatted. It will be passed arguments ( $self, $name, $arg
#	    ), where $self is the invocant, $name is the name of the
#	    formatter method, and $arg is a refernce to the arguments
#	    hash, which has already had _apply_defaults() called on it.
#	    This code is _not_ called if the invocant was initialized
#	    with title => 1.
#
#	{locale} - A hash specifying last-ditch localization
#	    information. The keys are locale, the formatter name
#	    (yes, this is a duplicate) and the item name.

my %formatter_data = (	# For generating formatters

    almanac	=> {
	default	=> {
	    width	=> 40,
	},
	dimension	=> {
	    dimension	=> 'almanac_pseudo_units',
	},
	fetch		=> sub {
	    my ( $self, undef, $arg ) = @_;	# $name unused
	    my $field = $arg->{units} ||= 'description';
	    return $self->_get( data => almanac => $field );
	},
    },

    altitude	=> {
	default	=> {
	    places	=> 1,
	    width	=> 7,
	},
	dimension	=> {
	    dimension	=> 'length',
	},
	fetch		=> sub {
	    my ( $self ) = @_;		# $name, $arg unused
	    my $value;
	    if ( my $body = $self->_get_eci( 'body' ) ) {
		$value = ( $body->geodetic() )[2];
	    }
	    return $value;
	},
    },

    angle =>	{
	default	=> {
	    places	=> 1,
	    width	=> 5,
	},
	dimension	=> {
	    dimension	=> 'angle_units',
	},
	fetch	=> sub {
	    my ( $self ) = @_;		# $name, $arg unused
	    return $self->_get( data => 'angle' );
	},
    },

    apoapsis => {
	default	=> {
	    as_altitude	=> 1,
	    places	=> 0,
	    width	=> 6,
	},
	dimension	=> {
	    dimension	=> 'length',
	},
	fetch		=> sub {
	    my ( $self, $name, $arg ) = @_;

	    my $body;
	    $body = $self->_get_eci( 'body' )
		and $body->can( $name )
		or return NONE;

	    my $value = $body->$name();

	    if ( $arg->{as_altitude} ) {
		$body->can( 'semimajor' )
		    or return NONE;
		$value -= $body->get( 'semimajor' );
	    }

	    return $value;
	},
    },

#   apogee	=> duplicated from apoapsis, below

    argument_of_perigee	=> {
	default	=> {
	    places	=> 4,
	    width	=> 9,
	},
	dimension	=> {
	    dimension	=> 'angle_units',
	},
	fetch	=> sub {
	    my ( $self ) = @_;		# $name, $arg unused
	    return $self->_get_tle_attr( body => 'argumentofperigee' );
	},
    },

    ascending_node => {
	default	=> {
	    places	=> 2,
	    width	=> 11,
	},
	dimension	=> {
	    dimension	=> 'angle_units',
	    units	=> 'right_ascension',
	},
	fetch	=> sub {
	    my ( $self ) = @_;		# $name, $arg unused
	    return $self->_get_tle_attr( body => 'ascendingnode' );
	},
    },

    azimuth	=> {
	chain	=> \&__chain_bearing,
	default	=> {
	    bearing	=> 0,
	    places	=> 1,
	    width	=> 5,
	},
	dimension	=> {
	    dimension	=> 'angle_units',
	},
	fetch	=> sub {
	    my ( $self ) = @_;		# $name, $arg unused
	    my $body = $self->_get_eci( 'body' )
		or return NONE;
	    my $station = $self->_get_eci( 'station' )
		or return NONE;
	    return ( $station->azel( $body ) )[0];
	},
    },

    b_star_drag	=> {
	default	=> {
	    places	=> 4,
	    width	=> 11,
	},
	dimension	=> {
	    dimension	=> 'scientific',
	},
	fetch	=> sub {
	    my ( $self ) = @_;		# $name, $arg unused
	    return $self->_get_tle_attr( body => 'bstardrag' );
	},
    },

    classification	=> {
	default	=> {
	    width	=> 1,
	},
	dimension	=> {
	    dimension	=> 'string_pseudo_units',
	},
	fetch	=> sub {
	    my ( $self ) = @_;		# $name, $arg unused
	    return $self->_get_tle_attr( body => 'classification' );
	},
    },

    date	=> {
	default	=> {
	    delta	=> 0,
	    format	=> undef,	# Just to get it looked at
	    gmt		=> undef,
	    places	=> 5,
	    round_time	=> undef,	# Just to get it looked at
	    width	=> '',
	},
	dimension	=> {
	    dimension	=> 'time_units',
	    format	=> [ 'date_format' ],
	},
	fetch	=> sub {
	    my ( $self, undef, $arg ) = @_;	# $name not used
	    defined( my $value = $self->_get( data => 'time' ) )
		or return NONE;
	    return $value + $arg->{delta};
	},
    },

    declination	=> {
	default	=> {
	    places	=> 1,
	    width	=> 5,
	},
	dimension	=> {
	    dimension	=> 'angle_units',
	},
	fetch	=> sub {
	    my ( $self ) = @_;		# $name, $arg unused
	    my $body = $self->_get_eci( 'body' )
		or return NONE;
	    my $station = $self->_get_eci( 'station' )
		or return NONE;
	    return ( $self->_get_precessed_coordinates(
		    equatorial => $body, $station ) )[ 1 ];
	},
    },

    eccentricity	=> {
	default	=> {
	    places	=> 5,
	    width	=> 8,
	},
	dimension	=> {
	    dimension	=> 'dimensionless',
	},
	fetch	=> sub {
	    my ( $self ) = @_;		# $name, $arg unused
	    return $self->_get_tle_attr( body => 'eccentricity' );
	},
    },

    effective_date	=> {
	default	=> {
	    format	=> undef,	# Just to get it looked at
	    gmt		=> undef,
	    places	=> '',
	    round_time	=> undef,	# Just to get it looked at
	    width	=> '',
	},
	dimension	=> {
	    dimension	=> 'time_units',
	    format	=> [ 'date_format', 'time_format' ],
	},
	fetch	=> sub {
	    my ( $self ) = @_;		# $name, $arg unused
	    return $self->_get_tle_attr( body => 'effective' );
	},
    },

    element_number	=> {
	default	=> {
	    align_left	=> 0,
	    width	=> 4,
	},
	dimension	=> {
	    dimension	=> 'string',
	},
	fetch	=> sub {
	    my ( $self ) = @_;		# $name, $arg unused
	    my $value = $self->_get_tle_attr( body => 'elementnumber' );
	    defined $value and $value =~ s/ \A \s+ //sxm;
	    return $value;
	},
    },

    elevation	=> {
	default	=> {
	    places	=> 1,
	    width	=> 5,
	},
	dimension	=> {
	    dimension	=> 'angle_units',
	},
	fetch	=> sub {
	    my ( $self ) = @_;		# $name, $arg unused
	    my $body = $self->_get_eci( 'body' )
		or return NONE;
	    my $station = $self->_get_eci( 'station' )
		or return NONE;
	    return ( $station->azel( $body ) )[1];
	},
    },

    ephemeris_type	=> {
	default	=> {
	    width	=> 1,
	},
	dimension	=> {
	    dimension	=> 'string_pseudo_units',
	},
	fetch	=> sub {
	    my ( $self ) = @_;		# $name, $arg unused
	    return $self->_get_tle_attr( body => 'ephemeristype' );
	},
    },

    epoch	=> {
	default	=> {
	    format	=> undef,	# Just to get it looked at
	    gmt		=> undef,
	    places	=> '',
	    round_time	=> undef,	# Just to get it looked at
	    width	=> '',
	},
	dimension	=> {
	    dimension	=> 'time_units',
	    format	=> [ 'date_format', 'time_format' ],
	},
	fetch	=> sub {
	    my ( $self ) = @_;		# $name, $arg unused
	    return $self->_get_tle_attr( body => 'epoch' );
	},
    },

    event	=> {
	default	=> {
	    width	=> 5,
	},
	dimension	=> {
	    dimension	=> 'event_pseudo_units',
	},
	fetch	=> sub {
	    my ( $self, $name ) = @_;	# $arg unused
	    defined( my $value = $self->_get( data => $name ) )
		or return NONE;
	    return $value;
	},
    },

    first_derivative	=> {
	default	=> {
	    places	=> 10,
	    width	=> 17,
	},
	dimension	=> {
	    dimension	=> 'angle_units',
	    formatter	=> '_format_number_scientific',
	},
	fetch	=> sub {
	    my ( $self ) = @_;		# $name, $arg unused
	    return $self->_get_tle_attr( body => 'firstderivative' );
	},
    },

    fraction_lit	=> {
	default	=> {
	    places	=> 2,
	    width	=> 4,
	},
	dimension	=> {
	    dimension	=> 'dimensionless',
	},
	fetch	=> sub {
	    my ( $self ) = @_;		# $name, $arg unused
	    my $body = $self->_get_eci( 'body' )
		or return NONE;
	    $body->can( 'phase' )
		or return NONE;
	    return ( $body->phase() )[1];
	},
    },

    illumination	=> {
	default	=> {
	    width	=> 5,
	},
	dimension	=> {
	    dimension	=> 'event_pseudo_units',
	},
	fetch	=> sub {
	    my ( $self, $name ) = @_;	# $arg unused
	    my $value;
	    defined( $value = $self->_get( data => $name ) )
		and $value ne ''
		and return $value;
	    return NONE;
	},
    },

    inclination	=> {
	default	=> {
	    places	=> 4,
	    width	=> 8,
	},
	dimension	=> {
	    dimension	=> 'angle_units',
	},
	fetch	=> sub {
	    my ( $self ) = @_;		# $name, $arg unused
	    return $self->_get_tle_attr( body => 'inclination' );
	},
    },

    inertial	=> {
	default	=> {
	    width	=> 1,
	},
	dimension	=> {
	    dimension	=> 'integer_pseudo_units',
	},
	fetch		=> sub {
	    my ( $self ) = @_;		# $name, $arg unused
	    my $body = $self->_get_eci( 'body' )
		or return NONE;
	    return $body->get( 'inertial' ) ? 1 : 0;
	},
    },

    international	=> {
	default	=> {
	    align_left	=> 1,
	    width	=> 8,
	},
	dimension	=> {
	    dimension	=> 'string_pseudo_units',
	},
	fetch	=> sub {
	    my ( $self ) = @_;		# $name, $arg unused
	    return $self->_get_tle_attr( body => 'international' );
	},
    },

    latitude	=> {
	default	=> {
	    places	=> 4,
	    width	=> 8,
	},
	dimension	=> {
	    dimension	=> 'angle_units',
	},
	fetch	=> sub {
	    my ( $self ) = @_;		# $name, $arg unused
	    my $body = $self->_get_eci( 'body' )
		or return NONE;
	    return ( $body->geodetic() )[0];
	},
    },

    longitude	=> {
	default	=> {
	    places	=> 4,
	    width	=> 9,
	},
	dimension	=> {
	    dimension	=> 'angle_units',
	},
	fetch	=> sub {
	    my ( $self ) = @_;		# $name, $arg unused
	    my $body = $self->_get_eci( 'body' )
		or return NONE;
	    return ( $body->geodetic() )[1];
	},
    },

    magnitude	=> {
	default	=> {
	    align_left	=> 0,
	    places	=> 1,
	    width	=> 4,
	},
	dimension	=> {
	    dimension	=> 'number',
	},
	fetch	=> sub {
	    my ( $self ) = @_;		# $name, $arg unused
	    my $mag;
	    defined( $mag = $self->_get( data => 'magnitude' ) )
		and return $mag;

	    my ( $body, $sta );
	    $body = $self->_get_eci( 'body' )
		and $body->can( 'magnitude' )
		and $sta = $self->_get_eci( 'station' )
		or return NONE;
	    if ( defined( my $time = $self->_get( data => 'time' ) ) ) {
		$body->universal( $time );
	    } elsif ( ! defined( $body->universal() ) ) {
		return NONE;
	    }
	    return $body->magnitude( $sta );
	},
    },

    maidenhead		=> {
	default => {
	    width	=> 6,
	    places	=> undef,
	},
	dimension	=> {
	    dimension	=> 'string_pseudo_units',
	},
	fetch	=> sub {
	    my ( $self, undef, $arg ) = @_;	# $name unused
	    my $body = $self->_get_eci( 'body' )
		or return NONE;
	    my $places = defined $arg->{places} ?
		$arg->{places} :
		$arg->{width} ?
		    floor( $arg->{width} / 2 ) :
		    3;
	    return ( $body->maidenhead( $places ) )[0];
	},
    },

    mean_anomaly	=> {
	default	=> {
	    places	=> 4,
	    width	=> 9,
	},
	dimension	=> {
	    dimension	=> 'angle_units',
	},
	fetch	=> sub {
	    my ( $self ) = @_;		# $name, $arg unused
	    return $self->_get_tle_attr( body => 'meananomaly' );
	},
    },

    mean_motion	=> {
	default	=> {
	    places	=> 10,
	    width	=> 12,
	},
	dimension	=> {
	    dimension	=> 'angle_units',
	},
	fetch	=> sub {
	    my ( $self ) = @_;		# $name, $arg unused
	    return $self->_get_tle_attr( body => 'meanmotion' );
	},
    },

    mma	=> {
	default	=> {
	    width	=> 3,
	},
	dimension	=> {
	    dimension	=> 'string_pseudo_units',
	},
	fetch	=> sub {
	    my ( $self ) = @_;		# $name, $arg unused
	    return $self->_get( data => 'mma' );
	},
    },

    name	=> {
	default	=> {
	    width	=> 24,	# Per http://celestrak.com/NORAD/documentation/tle-fmt.asp
	},
	dimension	=> {
	    dimension	=> 'string_pseudo_units',
	},
	fetch	=> sub {
	    my ( $self, undef, $arg ) = @_;	# $name unused
	    my $body = $self->_get_eci( 'body' )
		or return NONE;
	    my $value;
	    defined( $value = $body->get( 'name' ) )
		and return $value;
	    defined $arg->{missing}
		and 'oid' eq $arg->{missing}
		and return $body->get( 'id' );
	    return NONE;
	},
    },

    oid	=> {
	default	=> {
	    width	=> 6,
	},
	dimension	=> {
	    dimension	=> 'string_pseudo_units',
	},
	fetch	=> sub {
	    my ( $self, undef, $arg ) = @_;	# $name unused
	    my $body = $self->_get_eci( 'body' )
		or return NONE;
	    defined( my $value = $body->get( 'id' ) )
		or return NONE;
	    not defined $arg->{align_left}
		and $arg->{align_left} = $value !~ RE_ALL_DIGITS;
	    return $value;
	},
    },

    operational	=> {
	default	=> {
	    width	=> 1,
	},
	dimension	=> {
	    dimension	=> 'string_pseudo_units',
	},
	fetch	=> sub {
	    my ( $self ) = @_;		# $nane, $arg unused
	    return $self->_get_tle_attr( body => 'status' );
	},
    },

#   periapsis	=> duplicated from apoapsis, below

#   perigee	=> duplicated from apoapsis, below

    period	=> {
	default	=> {
	    places	=> 0,
	    width	=> 12,
	},
	dimension	=> {
	    dimension => 'duration',
	},
	fetch	=> sub {
	    my ( $self ) = @_;		# $name, $arg unused
	    my $body = $self->_get_eci( 'body' )
		or return NONE;
	    $body->can( 'period' )
		or return NONE;
	    return $body->period();
	},
    },

    phase	=> {
	default	=> {
	    places	=> 0,
	    width	=> 4,
	},
	dimension	=> {
	    dimension	=> 'angle_units',
	},
	fetch	=> sub {
	    my ( $self ) = @_;		# $name, $arg unused
	    my $body = $self->_get_eci( 'body' )
		or return NONE;
	    $body->can( 'phase' )
		or return NONE;
	    return ( $body->phase() )[0];
	},
    },

    range	=> {
	default	=> {
	    places	=> 1,
	    width	=> 10,
	},
	dimension	=> {
	    dimension	=> 'length',
	},
	fetch	=> sub {
	    my ( $self ) = @_;		# $name, $arg unused
	    my $body = $self->_get_eci( 'body' )
		or return NONE;
	    my $station = $self->_get_eci( 'station' )
		or return NONE;
	    return ( $station->azel( $body ) )[2];
	},
    },

    revolutions_at_epoch	=> {
	default	=> {
	    align_left	=> 0,
	    width	=> 6,
	},
	dimension	=> {
	    dimension	=> 'string',
	},
	fetch	=> sub {
	    my ( $self ) = @_;		# $name, $arg unused
	    my $value = $self->_get_tle_attr( body => 'revolutionsatepoch' );
	    defined $value and $value =~ s/ \A \s+ //sxm;
	    return $value;
	},
    },

    right_ascension	=> {
	default	=> {
	    places	=> 0,
	    width	=> 8,
	},
	dimension	=> {
	    dimension	=> 'angle_units',
	    units	=> 'right_ascension',
	},
	fetch	=> sub {
	    my ( $self ) = @_;		# $name, $arg unused
	    my $body = $self->_get_eci( 'body' )
		or return NONE;
	    my $station = $self->_get_eci( 'station' )
		or return NONE;
	    return ( $self->_get_precessed_coordinates(
		equatorial => $body, $station ) )[ 0 ];
	},
    },

    second_derivative	=> {
	default	=> {
	    places	=> 10,
	    width	=> 17,
	},
	dimension	=> {
	    dimension	=> 'angle_units',
	    formatter	=> '_format_number_scientific',
	},
	fetch	=> sub {
	    my ( $self ) = @_;		# $name, $arg unused
	    return $self->_get_tle_attr( body => 'secondderivative' );
	},
    },

    semimajor	=> {
	default	=> {
	    places	=> 0,
	    width	=> 6,
	},
	dimension	=> {
	    dimension	=> 'length',
	},
	fetch	=> sub {
	    my ( $self, $name ) = @_;	# $arg unused
	    my $body = $self->_get_eci( 'body' )
		or return NONE;
	    $body->can( $name )
		or return NONE;
	    return $body->$name();
	},
    },

#   semiminor	=> duplicated from semimajor, below

    status	=> {
	default	=> {
	    width	=> 60,
	},
	dimension	=> {
	    dimension	=> 'string_pseudo_units',
	},
	fetch	=> sub {
	    my ( $self ) = @_;		# $name, $arg unused
	    return $self->_get( data => 'status' );
	},
    },

    time	=> {
	default	=> {
	    delta	=> 0,
	    format	=> undef,	# Just to get it looked at
	    gmt		=> undef,
	    places	=> 5,
	    round_time	=> undef,	# Just to get it looked at
	    width	=> '',
	},
	dimension	=> {
	    dimension	=> 'time_units',
	    format	=> [ 'time_format' ],
	},
	fetch	=> sub {
	    my ( $self, undef, $arg ) = @_;	# $name unused
	    defined( my $value = $self->_get( data => 'time' ) )
		or return NONE;
	    return $value + $arg->{delta};
	},
    },

    tle	=> {
	default	=> {},
	dimension	=> {
	    dimension	=> 'string',
	},
	fetch	=> sub {
	    my ( $self ) = @_;	# $name, $arg unused
	    return $self->_get_tle_attr( body => 'tle' );
	},
    },

    type	=> {
	default	=> {
	    align_left	=> 1,
	    width	=> 3,
	},
	dimension	=> {
	    dimension	=> 'string_pseudo_units',
	},
	fetch	=> sub {
	    my ( $self ) = @_;	# $name, $arg unused
	    return $self->_get( data => 'type' );
	},
    },

);

foreach my $fmtr_name ( keys %formatter_data ) {
    $formatter_data{$fmtr_name}{name} = $fmtr_name;
}

sub _clone_formatter {
    my ( $from, $to ) = @_;
    %{ $formatter_data{$to} } = %{ $formatter_data{$from} };
    $formatter_data{$to}{name} = $to;
    return;
}

_clone_formatter( apoapsis  => 'apogee' );
_clone_formatter( apoapsis  => 'periapsis' );
_clone_formatter( apoapsis  => 'perigee' );
_clone_formatter( semimajor => 'semiminor' );

sub _fetch {
    my ( $self, $info, $name, $arg ) = @_;

    if ( ! $self->{internal}{time_set} ) {
	if ( defined( my $time = $self->_get( data => 'time' ) ) ) {
	    foreach my $key ( qw{ body station } ) {
		my $obj = $self->_get_eci( $key )
		    or next;
		$obj->universal( $time );
	    }
	}
	$self->{internal}{time_set} = 1;
    }
    return $info->{fetch}->( $self, $name, $arg );
}

sub __list_formatter_names {
    return ( keys %formatter_data );
}

sub __get_formatter_data {
    my ( undef, $name ) = @_;		# Invocant unused
    defined $name
	or return ( values %formatter_data );
    return $formatter_data{$name};
}

# Used when the normal reporting mechanism is unavailable.
sub _confess {
    my ( @arg ) = @_;
    require Carp;
    Carp::confess( @arg );
}

# Note that this implementation of add_formatter_method() modifies our
# name space by adding a stub method that dispatches to the
# object-specific code, or throws an error if there is none. The
# previous implementation used AUTOLOAD, but this had problems on most
# smokers involving calls to DESTROY(). I was never able to duplicate
# these, and rather than try to figure out how to handle any and all
# Perl-reserved subs, I decided to switch to an implementation which,
# while still fairly grody, did not use AUTOLOAD.
{
    my $fmtr_class = 'Astro::App::Satpass2::FormatValue::Formatter';
    my %defined_here;
    sub add_formatter_method {
	my ( $self, @formatters ) = @_;
	foreach my $fmtr_obj ( @formatters ) {
	    instance( $fmtr_obj, $fmtr_class )
		or $self->{warner}->wail(
		"Formatters must be instances of $fmtr_class" );
	    my $name = $fmtr_obj->name();
	    $self->can( $name )
		and not $defined_here{$name}
		and $self->{warner}->wail(
		"Formatter $name can not override built-in format" );
	    $self->{formatter_method}{$name}
		and $self->{warner}->wail(
		"Formatter $name can not replace previously-set formatter of same name" );
	    $self->{formatter_method}{$name} = $fmtr_obj;
	    unless ( $defined_here{$name} ) {
		$defined_here{$name} = 1;
		no strict qw{ refs };
		*$name = sub {
		    my ( $self ) = @_;
		    my $obj = $self->{formatter_method}{$name}
			or $self->{warner}->wail( "No such formatter as '$name'" );
		    goto &{ $obj->code() };
		};
	    }
	}
	return $self;
    }
}

sub __make_formatter_code {
    my ( $class, $fmtr ) = @_;

    HASH_REF eq ref $fmtr
	or _confess( 'The argument must be a HASH reference' );
    defined( my $fmtr_name = $fmtr->{name} )
	or _confess( 'The {name} must be defined' );

    # Validate the dimension information
    $fmtr->{dimension}
	or _confess(
	"'$fmtr_name' does not specify a {dimension} hash" );
    defined( my $dim_name = $fmtr->{dimension}{dimension} )
	or _confess(
	"'$fmtr_name' does not specify the dimension" );
    $dimensions{$dim_name}
	or _confess( "'$fmtr_name' specifies invalid dimension '$dim_name'" );
    if ( defined( my $dflt = $fmtr->{dimension}{default} ) ) {
	defined $dimensions{$dim_name}{define}{$dflt}
	    or _confess( "'$fmtr_name' specifies invalid default units '$dflt'" );
    }

    # If the dimension is 'time_units' we need to validate that the
    # format key is defined and valid
    if ( 'time_units' eq $dim_name ) {
	if ( ARRAY_REF eq ref $fmtr->{dimension}{format} ) {
	    foreach my $entry ( @{ $fmtr->{dimension}{format} } ) {
		$class->_valid_time_format_name( $entry )
		    or _confess(
		    "In '$fmtr_name', '$entry' is not a valid format" );
	    }
	    $fmtr->{default}{format} = sub {
		my ( $self ) = @_;
		return $self->_get_date_format_data( $fmtr_name, format => $fmtr );
	    };
	    $fmtr->{default}{width} = sub {
		my ( $self ) = @_;
		return $self->_get_date_format_data( $fmtr_name, width => $fmtr );
	    };
	} else {
	    _confess(
		"'$fmtr_name' must specify a {format} key in {dimension}" );
	}
	$fmtr->{default}{round_time} = sub {
	    my ( $self ) = @_;
	    return $self->{round_time};
	};
    }

    # Validate the fetch information
    CODE_REF eq ref $fmtr->{fetch}
	or _confess(
	"In '$fmtr_name', {fetch} is not a code reference" );

    return sub {
	my ( $self, %arg ) = _arguments( @_ );

	$self->_apply_defaults( \%arg, $fmtr );

	my $value = ( $self->{title} || defined $arg{literal} ) ?
	    NONE :
	    $self->_fetch( $fmtr, $fmtr_name, \%arg );

	my @rslt;
	foreach my $parm ( $fmtr->{chain} ?
	    $fmtr->{chain}->( $self, $fmtr_name, $value, \%arg ) :
	    \%arg ) {

	    push @rslt, defined $arg{literal} ?
		$self->_format_string( $arg{literal}, \%arg, $fmtr ) :
		$self->_apply_dimension( $value, $parm, $fmtr );

	}

	return join ' ', @rslt;
    };
}

sub __make_formatter_methods {
    my ( $class ) = @_;

    foreach my $fmtr ( $class->__get_formatter_data() ) {
	my $fmtr_name = $fmtr->{name};

	$class->can( $fmtr_name )
	    and next;

	my $fq = "${class}::$fmtr_name";

	no strict qw{ refs };

	*$fq = __PACKAGE__->__make_formatter_code( $fmtr );

    }
    return;
}

__PACKAGE__->__make_formatter_methods();

#	Title control

# sub is_valid_title_gravity would normally be here, but in order to
# reduce technical debt it shares a hash with _do_title(), and is placed
# with it, below.

sub more_title_lines {
    my ( $self ) = @_;
    exists $self->{internal}{_title_info}
	or return 1;
    my $more;
    if ( $more = delete $self->{internal}{_title_info}{more} ) {
	$self->{internal}{_title_info}{inx}++
    } else {
	$self->reset_title_lines();
    }
    return $more;
}

sub reset_title_lines {
    my ( $self ) = @_;
    delete $self->{internal}{_title_info};
    return;
}

#	Private methods and subroutines of all sorts.

{

    my @always = qw{ align_left missing title };

    sub _apply_defaults {
	my ( $self, $arg, $fmtr ) = @_;

	my $fmtr_name = $fmtr->{name};
	my $dflt = $fmtr->{default} || {};

	defined $arg->{width}
	    or $self->{fixed_width}
	    or $arg->{width} = '';

	if ( defined $arg->{format} && ! defined $arg->{width} ) {
	    $arg->{width} = $self->{time_formatter}->
		format_datetime_width( $arg->{format} );
	}

	# TODO maybe apply locale here? But see also _do_title.
	APPLY_DEFAULT_LOOP:
	foreach my $key ( keys %{ $dflt }, @always ) {

	    defined $arg->{$key} and next;

	    foreach my $source ( qw{ default internal } ) {
		defined( $arg->{$key} = $self->_get( $source, $fmtr_name,
			$key ) )
		    and next APPLY_DEFAULT_LOOP;
	    }

            defined( $arg->{$key} = __localize(
		    text	=> [ $fmtr_name, $key ],
		    locale	=> $fmtr->{locale},
		) )
		and next;

	    my $default = $dflt->{$key};
	    $arg->{$key} = CODE_REF eq ref $default ?
		$default->( $self, $fmtr_name, $arg ) : $default

	}

	defined $arg->{width}
	    or $arg->{width} = '';
	$arg->{width} =~ m/ \D /sxm
	    and $arg->{width} = '';

	if ( $self->{report} ) {
	    my $report = "-$self->{report}";
	    foreach my $key ( qw{ literal missing title } ) {
		defined $arg->{$key}
		    or next;
		$arg->{$key} = __localize(
		    text	=> [ $report, 'string', $arg->{$key} ],
		    default	=> $arg->{$key},
		    locale	=> $fmtr->{locale},
		);
	    }

	}

	return;
    }

}

sub _apply_dimension {
    my ( $self, $value, $arg, $fmtr ) = @_;

    my $fmtr_name = $fmtr->{name};
    defined( my $dim_name = $fmtr->{dimension}{dimension} )
	or $self->weep( 'No dimension specified' );

    my $dim;
    $dim = $dimensions{$dim_name}
	and defined( my $unit_name = _dor( $arg->{units}, $fmtr->{dimension}{units},
	    $self->_get( default => $fmtr_name, 'units' ),
	    $dim->{default} ) )
	or $self->weep( "Dimension $dim_name undefined" );

    my $unit = $dim->{define}{$unit_name}
	or $self->{warner}->wail(
	    "Units $unit_name not valid for $dim_name" );

    if ( defined $unit->{alias} ) {
	my $alias = $dim->{define}{$unit->{alias}}
	    or $self->weep( "Undefined alias '$unit->{alias}'" );
	$unit_name = $unit->{alias};
	$unit = $alias;
    }

    defined $arg->{align_left}
	or $arg->{align_left} = _dor( $unit->{align_left},
	    $dim->{align_left} );

    $self->{title}
	and return $self->_do_title( $arg, $fmtr );

    defined $value
	or return $self->_format_undef( undef, $arg, $fmtr );

    defined $unit->{method}
	and do {
	my $method = $unit->{method};
	defined( $value = $self->$method( $value ) )
	    or return $self->_format_undef( undef, $arg, $fmtr );
    };

    defined $unit->{factor}
	and $value *= $unit->{factor};

    defined $unit->{gmt}
	and not defined $arg->{gmt}
	and $arg->{gmt} = $unit->{gmt};

    $arg->{units} = $unit_name;

    $value = __localize(
	text	=> [ $fmtr_name, 'localize_value', $value ],
	default	=> $value,
	locale	=> $fmtr->{locale},
    );

    defined( my $formatter = _dor( $unit->{formatter},
	    $fmtr->{dimension}{formatter},
	    $dim->{formatter},
	) )
	or $self->weep( "No formatter for $dim_name $unit_name" );

    return $self->$formatter( $value, $arg, $fmtr );
}

sub _arguments {
    my @arg = @_;

    my $obj = shift @arg;
    my $hash = HASH_REF eq ref $arg[-1] ? pop @arg : {};

    my ( @clean, @append );
    foreach my $item ( @arg ) {
	if ( has_method( $item, 'dereference' ) ) {
	    push @append, $item->dereference();
	} else {
	    push @clean, $item;
	}
    }

    @clean % 2 and splice @clean, 0, 0, 'title';

    return ( $obj, %{ $hash }, @clean, @append );
}

=begin comment

# TODO remove this after October 1 2016
# It's only still here because, although I can't find a call for it, and
# testcover shows it is not called, I'm paranoid that I did something
# tricky that I can not now remember and is not covered by the tests.

sub _attrib_hash {
    my ( $self, $name, @arg ) = @_;
    if ( @arg ) {
	my $value = shift @arg;
	ref $value
	    and HASH_REF eq reftype( $value )
	    or $self->{warner}->wail(
	    "Attribute $name must be a hash reference" );
	$self->{$name} = $value;
	return $self;
    } else {
	return $self->{$name};
    }
}

=end comment

=cut

{

    my %do_title = (
	TITLE_GRAVITY_TOP() => sub {
	    my ( $self, $wrapped, $arg, $fmtr ) = @_;
	    defined $self->{internal}{_title_info}{inx}
		or $self->{internal}{_title_info}{inx} = 0;
	    my $inx = $self->{internal}{_title_info}{inx};
	    $self->{internal}{_title_info}{more} ||=
		defined $wrapped->[$inx + 1];

	    return defined $wrapped->[$inx] ?
		$wrapped->[$inx] :
		$self->_format_string( '', $arg, $fmtr );
	},
	TITLE_GRAVITY_BOTTOM() => sub {
	    my ( $self, $wrapped, $arg, $fmtr ) = @_;
	    defined $self->{internal}{_title_info}{inx}
		or do {
		$self->{internal}{_title_info}{inx} = -1;
		$self->{internal}{_title_info}{max} = 0;
	    };
	    my $size = @{ $wrapped };
	    my $inx = $self->{internal}{_title_info}{inx};
	    if ( $inx < 0 ) {
		$self->{internal}{_title_info}{max} = max(
		    $size,
		    $self->{internal}{_title_info}{max},
		);
	    }
	    my $max = $self->{internal}{_title_info}{max};
	    $self->{internal}{_title_info}{more} ||= $inx + 1 < $max;
	    $inx = $inx - $max + $size;
	    return ( $inx >= 0 && defined $wrapped->[$inx] ) ?
		$wrapped->[$inx] :
		$self->_format_string( '', $arg, $fmtr );
	},
    );

    sub _do_title {
	my ( $self, $arg, $fmtr ) = @_;
	my $fmtr_name = $fmtr->{name};
	# TODO this looks like a good place to insert localized title
	# code. But see also _apply_defaults().
	defined $arg->{title}
	    or $arg->{title} = '';
	my $title = $arg->{title};
	my $wrapped = $self->{internal}{$fmtr_name}{_title}{$title}{$arg->{width}}
	    ||= $self->_do_title_wrap( $arg, $fmtr );

	return $do_title{$self->{title_gravity}}->( $self, $wrapped,
	    $arg, $fmtr );
    }

    sub is_valid_title_gravity {
	my ( @args ) = @_;
	defined( my $value = pop @args )
	    or return 0;
	return $do_title{$value} ? 1 : 0;
    }

}

sub _do_title_wrap {
    my ( $self, $arg, $fmtr ) = @_;
    my $title = $arg->{title};
    $arg->{width} eq ''
	and return [ $title ];
    $arg->{width}
	or return [ '' ];
    local $Text::Wrap::columns = $arg->{width} + 1;
    local $Text::Wrap::huge = 'overflow';
    my $wrap = Text::Wrap::wrap( '', '', $title );
    my @lines = split qr{ \n }sxm, $wrap;
    return [ map { $self->_format_string( $_, $arg, $fmtr ) } @lines ];
}

sub __chain_bearing {
    my ( undef, undef, $value, $arg ) = @_;	# Invocant, $name unused
    $arg->{bearing}
	and $arg->{bearing} =~ RE_ALL_DIGITS
	or $arg->{bearing} = 0;

    $arg->{bearing} or return $arg;

    if ( defined $value ) {
	my $ab = { %{ $arg } };	# Shallow clone
	$ab->{width} and $ab->{width} = $ab->{bearing};
	$ab->{units} = 'bearing';
	return ( $arg, $ab );
    } else {
	$arg->{width}
	    and $arg->{width} += $arg->{bearing} + 1;
	return $arg;
    }
}

sub _dor {
    foreach ( @_ ) {
	defined $_ and return $_;
    }
    return $_[-1];
}

sub _get {
    my ( $self, @arg ) = @_;
    my $hash = $self;
    foreach my $key ( @arg ) {
	ref $hash or return NONE;
	defined $key
	    or $self->weep( 'Undefined key' );
	my $ref = reftype( $hash );
	if ( HASH_REF eq $ref ) {
	    $hash = $hash->{$key};
	} elsif ( ARRAY_REF eq $ref ) {
	    $hash = $hash->[$key];
	} elsif ( CODE_REF eq $ref ) {
	    $hash = $hash->( $self, $key );
	} else {
	    return NONE;
	}
    }
    return $hash;
}

sub _get_eci {
    my ( $self, @arg ) = @_;
    my $eci = $self->_get( data => @arg );
    embodies( $eci, 'Astro::Coord::ECI' )
	and return $eci;
    return NONE;
}

#	@coords = $self->_get_precessed_coordinates( $method, $body,
#			$station );
#
#	This method fetches the coordinates of the given body which are
#	specified by the given method. These must be inertial, and are
#	precessed if desired. If the body is not defined, nothing is
#	returned. If the station is passed, the coordinates are relative
#	to it; if it is undefined, nothing is returned.

sub _get_precessed_coordinates {
    my ( $self, $method, $body, $station ) = @_;

    foreach my $thing ( $body, $station ) {
	embodies( $thing, 'Astro::Coord::ECI' )
	    or return;
    }

    # TODO need to set station time from body? I think not now, but
    # Astro::App::Satpass2::FormatValue needed this.

    if ( my $equinox = $self->{desired_equinox_dynamical} ) {
	foreach my $thing ( $body, $station ) {
	    $thing = $thing->clone()->precess_dynamical( $equinox );
	}
    }

    return $station->$method( $body );
}

sub _get_tle {
    my ( $self, @arg ) = @_;
    my $tle = $self->_get( data => @arg );
    embodies( $tle, 'Astro::Coord::ECI::TLE' )
	and return $tle;
    return NONE;
}

sub _get_tle_attr {
    my ( $self, @arg ) = @_;
    my $attr = pop @arg;
    my $tle = $self->_get( data => @arg );
    embodies( $tle, 'Astro::Coord::ECI::TLE' )
	and $tle->attribute( $attr )
	or return NONE;
    return $tle->get( $attr );
}

#	$string = $self->_format_*( $value, \%arg, \%fmtr );
#
#	These methods take the value and turn it into a string.
#	Recognized arguments are:
#	    {places} => decimal places, ignored if not a non-negative
#		number;
#	    {width} => field width, ignored if not a non-negative
#		number;

# Called as $self->$method()
sub _format_bearing {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ( $self, $value, $arg, $fmtr ) = @_;
    defined $value
	or goto &_format_undef;

    my $table;

    foreach my $source ( qw{ default } ) {
	$table = $self->_get( $source => bearing => 'table' )
	    and last;
    }

    $table ||= __localize(
	text	=> [ bearing => 'table' ],
	default	=> [],
	locale	=> $fmtr->{locale},
    );

    $arg->{bearing}
	or $arg->{bearing} = ( $arg->{width} || 2 );
    $arg->{width}
	and $arg->{bearing} > $arg->{width}
	and $arg->{bearing} = $arg->{width};

    my $inx = min( $arg->{bearing} || 2, scalar @{ $table } ) - 1;
    my $tags = $table->[$inx];
    my $bins = @{ $tags };
    $inx = floor ($value / TWOPI * $bins + .5) % $bins;
    return $self->_format_string( $tags->[$inx], $arg, $fmtr );
}

# Called as $self->$method()
sub _format_duration {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ( $self, $value, $arg, $fmtr ) = @_;

    defined $arg->{align_left}
	or $arg->{align_left} = 0;

    defined $value
	or goto &_format_undef;

    my $secs = floor ($value + .5);
    my $mins = floor ($secs / 60);
    $secs %= 60;
    my $hrs = floor ($mins / 60);
    $mins %= 60;
    my $days = floor ($hrs / 24);
    $hrs %= 24;

    my $buffer;
    if ($days > 0) {
	$buffer = sprintf '%d %02d:%02d:%02d', $days, $hrs, $mins, $secs;
    } else {
	$buffer = sprintf '%02d:%02d:%02d', $hrs, $mins, $secs;
    }

    '' eq $arg->{width}
	and return $buffer;

    length $buffer <= $arg->{width}
	or $self->{overflow}
	or return '*' x $arg->{width};

    $arg->{width} - length $buffer
	or return $buffer;

    return $self->_format_string( $buffer, $arg, $fmtr );
}

# Called as $self->$method()
sub _format_event {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ( $self, $value, $arg, $fmtr ) = @_;

    defined $value
	or goto &_format_undef;

    isdual( $value )
	or $value !~ m/ \D /sxm
	or goto &_format_string;

    my $table;
    if ( 'string' ne $arg->{units} ) {
	foreach my $source ( qw{ default } ) {
	    $table = $self->_get( $source => event => 'table' )
		and last;
	}
    }
    $table ||= __localize(
	text	=> [ event => 'table' ],
	default	=> [],
    );

    return $self->_format_string( $table->[$value] || '', $arg, $fmtr );
}

# Called as $self->$method()
sub _format_integer {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ( $self, $value, $arg ) = @_;	# $fmtr unused
    defined $value
	or goto &_format_undef;

    $arg->{width}
	and $arg->{width} =~ RE_ALL_DIGITS
	or return sprintf '%d', $value;

    my $buffer = sprintf '%*d', $arg->{width}, $value;

    length $buffer <= $arg->{width}
	or $self->{overflow}
	or return '*' x $arg->{width};

    return $buffer;
}

# Called as $self->$method()
sub _format_lower_case {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ( $self, $value, $arg, $fmtr ) = @_;
    defined $value
	or goto &_format_undef;

    return $self->_format_string( lc $value, $arg, $fmtr );
}

# Called as $self->$method()
sub _format_number {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ( $self, $value, $arg, $fmtr ) = @_;
    defined $value
	and $value ne ''
	or goto &_format_undef;

    my $width = ( $arg->{width} && $arg->{width} =~ RE_ALL_DIGITS )
	? $arg->{width} : '';
    my $tplt = "%$width";
    defined $arg->{places}
	and $arg->{places} =~ RE_ALL_DIGITS
	and $tplt .= ".$arg->{places}";

    '%' eq $tplt
	and return "$value";

    my $buffer = sprintf $tplt . 'f', $value;

    # The following line is because sprintf '%.1f', 0.04 produces
    # '-0.0'. This may not be a bug, given what 'perldoc -f sprintf'
    # says, but it sure looks like a wart to me.
    $buffer =~ s/ \A ( \s* ) - ( 0* [.]? 0* \s* ) \z /$1 $2/smx;

    $width or return $buffer;

    if ($width && length $buffer > $width && $width >= 7) {
	$arg->{places} = $width - 7;
	return $self->_format_number_scientific( $value, $arg, $fmtr );
    }

    length $buffer <= $width
	or $self->{overflow}
	or return '*' x $width;

    return $buffer;
}

sub _format_number_scientific {
    my ( $self, $value, $arg ) = @_;	# $fmtr unused
    defined $value
	and $value ne ''
	or goto &_format_undef;

    my $width = ( $arg->{width} && $arg->{width} =~ RE_ALL_DIGITS )
	? $arg->{width} : '';
    my $tplt = "%$width";
    defined $arg->{places}
	and $arg->{places} =~ RE_ALL_DIGITS
	and $tplt .= ".$arg->{places}";
    $tplt .= 'e';

    my $buffer = sprintf $tplt, $value;
    $buffer =~ s/ e ( [-+]? ) 0 ( [0-9]{2} ) \z /e$1$2/smx	# Normalize
	and $width
	and $width > length $buffer
	and $buffer = ' ' . $buffer;	# Preserve width after normalize

    $width
	or return $buffer;

    length $buffer <= $width
	or $self->{overflow}
	or return '*' x $width;

    return $buffer;
}

# Called as $self->$method()
sub _format_phase {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ( $self, $value, $arg, $fmtr ) = @_;
    defined $value
	or goto &_format_undef;
    my $angle = rad2deg( $value );

    my $table;
    foreach my $source ( qw{ default } ) {
	$table = $self->_get( $source => phase => 'table' )
	    and last;
    }
    $table ||= __localize(
	text	=> [ phase => 'table' ],
	default	=> [],
	locale	=> $fmtr->{locale},
    );
    foreach my $entry ( @{ $table } ) {
	$entry->[0] > $angle or next;
	return $self->_format_string( $entry->[1], $arg, $fmtr );
    }
    return $self->_format_string( $table->[0][1], $arg, $fmtr );
}

# Called as $self->$method()
sub _format_right_ascension {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ( $self, $value, $arg, $fmtr ) = @_;
    defined $value
	or goto &_format_undef;
    my $sec = $value / PI * 12;
    my $hr = floor($sec);
    $sec = ($sec - $hr) * 60;
    my $min = floor($sec);
    $sec = ($sec - $min) * 60;
    my ( $ps, $wid );
    if ( defined $arg->{places} && $arg->{places} =~ RE_ALL_DIGITS )
    {
	$ps = ".$arg->{places}";
	$wid = $arg->{places} ? 3 + $arg->{places} : 2;
    } else {
	$ps = '';
	$wid = 2;
    }
    defined $arg->{align_left}
	or $arg->{align_left} = 0;
    return $self->_format_string(
	sprintf( "%02d:%02d:%0$wid${ps}f", $hr, $min, $sec ), $arg,
	$fmtr );
}

sub _format_string {
    my ( $self, $value, $arg ) = @_;	# $fmtr unused

    defined $value
	or goto &_format_undef;

    defined $arg->{width}
	and $arg->{width} =~ RE_ALL_DIGITS
	or return "$value";

    my $left = defined $arg->{align_left} ? $arg->{align_left} : 1;
    $left = $left ? '-' : '';

    my $buffer = sprintf "%$left*s", $arg->{width}, $value;

    length $buffer <= $arg->{width}
	or $self->{overflow}
	or return substr $buffer, 0, $arg->{width};

    return $buffer;
}

# Called as $self->$method()
sub _format_time {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ( $self, $value, $arg, $fmtr ) = @_;
    defined $value
	or goto &_format_undef;

    my $time_fmtr = $self->{time_formatter};
    $time_fmtr->round_time( $arg->{round_time} );
    my $fmt = $arg->{format};
    defined $fmt
	or $self->weep( 'No time format' );

    my $buffer = $time_fmtr->format_datetime(
	$fmt, $value, $arg->{gmt} );
    return $self->_format_string( $buffer, $arg, $fmtr );
}

# Called as $self->$method()
sub _format_title_case {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ( $self, $value, $arg, $fmtr ) = @_;
    defined $value
	or goto &_format_undef;

##  $value = join '', map { ucfirst lc $_ }
##	split qr{ (?<= [^[:alpha:]] ) (?= [[:alpha:]] ) }sxm, $value;
    $value =~ s{ (?: \A | (?<= \s ) ) ( [[:alpha:]] \S* ) }
	{ ucfirst lc $1 }sxmge;
    return $self->_format_string( $value, $arg, $fmtr );
}

sub _format_undef {
    my ( $self, undef, $arg, $fmtr ) = @_;	# $value unused

    $self->{title}
	and defined $arg->{title}
	and return $self->_format_string( $arg->{title}, $arg, $fmtr );

    defined $arg->{missing}
	and return $self->_format_string( $arg->{missing}, $arg, $fmtr );

    defined $arg->{width}
	and $arg->{width} =~ RE_ALL_DIGITS
	and $arg->{width}
	or return '';

    return ' ' x $arg->{width};
}

# Called as $self->$method()
sub _format_upper_case {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ( $self, $value, $arg, $fmtr ) = @_;
    defined $value
	or goto &_format_undef;

    return $self->_format_string( uc $value, $arg, $fmtr );
}

# Called as $self->$method()
sub _julian_day {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ( undef, $value ) = @_;		# Invocant unused
    return julianday( $value );
}

sub _get_date_format_data {
    my ( $self, $name, $datum, $info ) = @_;
    $self->{internal}{_date_format}{$name} ||=
	$self->_manufacture_date_format( $name, $info );
    return $self->{internal}{_date_format}{$name}{$datum};
}

sub _manufacture_date_format {
    my ( $self, undef, $info ) = @_;	# $name unused
    my $fmt = join ' ', grep { defined $_ && '' ne $_ }
	map { $self->{$_} } @{ $info->{dimension}{format} };
    my $wid =
	$self->{time_formatter}->format_datetime_width( $fmt );
    return { format => $fmt, width => $wid };
}

{

    my %fmt;

    BEGIN {
	%fmt = map { $_ => 1 } qw{ date_format time_format };
    }

    sub _valid_time_format_name {
	my ( undef, $name ) = @_;
	return $fmt{$name};
    }
}

=begin comment

# TODO remove this after October 1 2016
# It's only still here because, although I can't find a call for it, and
# testcover shows it is not called, I'm paranoid that I did something
# tricky that I can not now remember and is not covered by the tests.

sub _set_time_format {
    my ($self, $name, $data) = @_;
    $self->_valid_time_format( $name )
	or $self->weep(
	    "'$name' invalid for _set_time_format()" );
    $self->{$name} = $data;
    delete $self->{internal}{_date_format};

    return $self;
}

=end comment

=cut

# Called as $self->$method()
sub _subtract_epoch {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ( $self, $value ) = @_;
    my $epoch = $self->_get_tle_attr( body => 'epoch' );
    defined $epoch
	or return $epoch;
    return $value - $epoch;
}

sub _variant {
    my ( $self, $variant ) = @_;

    my $data;
    if ( defined $variant ) {
	$data = HASH_REF eq ref $variant ? $variant : {	# Shallow clone
	    %{ $self->_get( data => $variant ) || {} }
	};
	foreach my $key ( qw{ station time } ) {
	    $data->{$key} = $self->_get( data => $key );
	}
    } else {
	$data = { %{ $self->_get( 'data' ) } };	# Shallow clone
    }

    return $self->clone( data => $data );
}

1;

__END__