Astro-satpass

 view release on metacpan or  search on metacpan

script/satpass  view on Meta::CPAN

	while (1) {
	    my ($time, undef, $quarter) = $body->next_quarter;
	    last if $time > $end;
	    push @data, [$time, $quarter];
	    }
    }

#	Sort and display the quarter-phase information.

    foreach (sort {$a->[0] <=> $b->[0]} @data) {
	if ($cmdopt{dump}) {
	    if ($cmdopt{flatten}) {
		local $Data::Dumper::Terse = 1;
		print Dumper (_flatten ($_));
	    } else {
		print Dumper $_;
	    }
	} else {
	    my ($time, $quarter) = @$_;
	    print _my_strftime( $dtfmt, $time ), " $quarter\n";
	}
    }

}

########################################################################
#
#	retrieve () - Reload the observing list using Storable::retrieve.
#

sub retrieve {
@bodies = @{Storable::retrieve (_storable (@_))};
}

########################################################################
#
#	set () - set the values of parameters
#

sub set {
while (@_) {
    my $name = shift;
    my $value = shift;
    if ($mutator{$name}) {
	$mutator{$name}->($name, $value);
	$exported{$name} and $ENV{$name} = $parm{$name};
	}
      else {
	die <<eod;
Warning - Unknown parameter '$name'.
eod
	}
    }    
}

sub _set_almanac_horizon {
    my ( $name, $value ) = @_;
    $value = _parse_angle( $value );
    Astro::Coord::ECI->new( almanac_horizon => $value );
    $parm{$name} = $value;
    $parm{"_$name"} = looks_like_number( $value ) ?
	deg2rad( $value ) :
	$value;
    return;
}

sub _set_angle {
    my ( $name, $value ) = @_;
    $parm{$name} = _parse_angle( $value );
    $parm{"_$name"} = deg2rad( $value );
    return;
}

sub _set_angle_or_undef {
    defined $_[1]
	and $_[1] ne 'undef'
	and goto &_set_angle;
    $parm{$_[0]} = $parm{"_$_[0]"} = undef;
    return;
}

sub _set_eci_class {
    my ( $name, $val, $class ) = @_;
    $class ||= 'Astro::Coord::ECI';
    ref $val and die "Error - $name must not be a reference\n";
    if ( defined $val ) {
	_load_module( $val );
	$val->isa( $class )
	    or die "Error - $name must be an $class\n";
    } else {
	$val = $class;
    }
    $parm{$name} = $val;
    $help_module{$name}
	and $help_module{$name} = $val;
    foreach my $body ( @bodies ) {
	$body->set( $name => $val );
    }
    if ( defined( my $inx = _find_in_sky( $name ) ) ) {
	splice @sky, $inx, $inx + 1, $val->new();
    }
    return;
}

sub _set_ellipsoid {
Astro::Coord::ECI->set (ellipsoid => $_[1]);
$parm{$_[0]} = $_[1];
}

sub _set_illum_class {
    $_[2] = 'Astro::Coord::ECI';
    goto &_set_eci_class;
}

sub _set_local_coord {
my $method = "_format_local_$_[1]";
die <<eod unless __PACKAGE__->can ($method);
Error - Illegal local coordinate specification. The only legal values
        are @{[join ', ', _find_suffixes ('_format_local_')]}
eod
$parm{$_[0]} = $_[1];

script/satpass  view on Meta::CPAN

	$parm{$_[0]} = $_[1];
    } else {
	my @lglver;
	no strict qw{refs};
	foreach (keys %{*{__PACKAGE__ . '::'}}) {
	    m/^_simbad(\d+)/ && __PACKAGE__->can ($_)
		and push @lglver, $1;
	}
	@lglver = sort {$a <=> $b} @lglver;
	my $lastver = pop @lglver;
	if (@lglver) {
	    die <<eod;
Error - Invalid SIMBAD version number $_[1]. Must be @{[
    join ', ', @lglver]} or $lastver.
eod
	} else {
	    die <<eod;
Error - Invalid SIMBAD version number $_[1]. Must be $lastver.
eod
	}
    }
}

sub _set_sun_class {
    my ( $name, $val ) = @_;
    _set_eci_class( $name, $val, SUN_CLASS_DEFAULT );
    foreach my $body ( @sky ) {
	$body->set( sun => $val );
    }
}

sub _set_time {
    my ($name, $val) = @_;
    if ($val) {
	$parm{$name} = _parse_time ($val);
    } else {
	$parm{$name} = 0;
    }
}

sub _set_twilight {
if (my $key = $twilight_abbr{lc $_[1]}) {
    $parm{$_[0]} = $key;
    $parm{_twilight} = $twilight_def{$key};
    }
  else {
    my $angle = _parse_angle ($_[1]);
    $angle =~ m/^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/ or
	die <<eod;
Error - The twilight setting must be 'civil', 'nautical', or
        'astronomical', or a unique abbreviation thereof, or a number
        of degrees the geometric center of the sun is below the
        horizon.
eod
    $parm{$_[0]} = $_[1];
    $parm{_twilight} = - deg2rad (abs ($angle));
    }
}

sub _set_tz {
    if ($_[1] || looks_like_number ($_[1])) {
	$ENV{TZ} = $parm{$_[0]} = $_[1];
	$parm{perltime} and _parse_time_absolute_use_perltime()
	    or _parse_time_absolute_init( $_[1] );
    } else {
	$parm{$_[0]} = undef;
	delete $ENV{TZ};
	$parm{perltime} and _parse_time_absolute_use_perltime()
	    or _parse_time_absolute_init();
    }
}

sub _set_unmodified {$parm{$_[0]} = $_[1]}

sub _set_webcmd {
$parm{$_[0]} = $_[1];
my $st = _get_spacetrack (1);	# Get only if already instantiated.
$st and $st->set (webcmd => $_[1]);
}

########################################################################
#
#	show () - display the values of parameters
#

sub show {
    my @arg = @_;
    @arg
	or @arg = grep { m/ \A [[:alpha:]] /smx } sort keys %parm;
    foreach my $name ( @arg ) {
	exists $accessor{$name} or die <<"EOD";
Error - '$name' is not a valid setting.
EOD
	exists $parm{$name} or next;
	my $val = _quoter ($accessor{$name}->($name));
	print "set $name $val\n";
    }
}

sub _show_unmodified {
defined $parm{$_[0]} ? $parm{$_[0]} : 'undef'
}

########################################################################
#
#	sky () - handle manipulation of the sky. What happens is based
#		on the arguments as follows:
#		none - list
#		'add body' - add the named body, if it is not already
#			there. If the body is not 'sun' or 'moon' it
#			is assumed to be a star of the given name,
#			and coordinates must be given.
#		'clear' - clear
#		'drop name ...' - drop the named bodies; the name match
#			is by case-insensitive regular expression.
#		'lookup name' - Look up the star name in the SIMBAD
#			catalog, and add it as a background body if
#			found.
#

# For proper motion, we need to convert arc seconds per year to degrees

script/satpass  view on Meta::CPAN

#
#	Returns a string representing the $epoch formatted with the
#	given strftime() format. The string is GMT if the gmt parameter
#	is true, or local time if it is false.
sub _my_strftime {
    my ( $format, $epoch ) = @_;
    return $parm{gmt} ?
	gm_strftime( $format, $epoch ) :
	local_strftime( $format, $epoch );
}

#	$angle = _parse_angle ($string)

#	Parses an angle in degrees, hours:minutes:seconds, or
#	degreesDminutesMsecondsS and returns the angle in degrees.
#
#	NOTE that the almanac_horizon code relies on this returning
#	whatever it is given unless it is recognized as
#	hours:minutes:seconds or degreesDminutesMsecondsS.

sub _parse_angle {
my $angle = shift;
defined $angle or return;
if ($angle =~ m/:/) {
    my ($h, $m, $s) = split ':', $angle;
    $s ||= 0;
    $m ||= 0;
    $h ||= 0;
    $m += $s / 60;
    $h += $m / 60;
    $angle = $h * 360 / 24;
    }
  elsif ($angle =~ m/^([+\-])?(\d*)d(\d*(?:\.\d*)?)(?:m(\d*(?:\.\d*)?)s?)?$/i) {
    $angle = ((($4 || 0) / 60) + ($3 || 0)) / 60 + ($2 || 0);
    $angle = -$angle if $1 && $1 eq '-';
    }
$angle;
}

#	$distance = _parse_distance ($string, $units)

#	Strips 'm', 'km', 'au', 'ly', or 'pc' from the end of $string,
#	the default being $units. Converts to km.

BEGIN {
my %units = (
    m => .001,
    km => 1,
    au => AU,
    ly => LIGHTYEAR,
    pc => PARSEC,
    );

sub _parse_distance {
my ($string, $dfdist) = @_;
my $dfunits = $dfdist =~ s/([[:alpha:]]+)$// ? $1 : 'km';
my $units = lc ($string =~ s/([[:alpha:]]+)$// ? $1 : $dfunits);
$units{$units} or die <<eod;
Error - Units of '$units' are unknown.
eod
looks_like_number ($string) or die <<eod;
Error - '$string' is not a number.
eod
$string * $units{$units};
}
}	# end of BEGIN block

#	$time = _parse_time ($string, $default)

#	Parses a time string in any known format. Strings with a
#	leading "+" or "-" are assumed to be relative to the last
#	explicit setting. Otherwise the time is assumed to be explicit,
#	and passed to Date::Manip. The parsed time is returned. If the
#	time to be parsed is false (in the Perl sense) we return the
#	default (if specified) or the current time. We die on an
#	invalid time.

BEGIN {	# Begin local symbol block.

    my $last_time_set = time ();
    my $initial_time_set = $last_time_set;

    sub _parse_time {
    my $time = $_[0] or return $_[1] || time ();
    if ($time =~ m/^([\+\-])\s*(\d+)(?:\s+(\d+)(?::(\d+)(?::(\d+))?)?)?/) {
	my $delta = ((($2 || 0) * 24 + ($3 || 0)) * 60 +
	    ($4 || 0)) * 60 + ($5 || 0);
	$last_time_set = $1 eq '+' ?
	    $last_time_set + $delta :
	    $last_time_set - $delta;
	}
      else {
	defined( my $parsed_time =
	    _parse_time_absolute( $time ) )
	    or die <<eod;
Error - Invalid time '$time'
eod
	$last_time_set = $parsed_time;
	$parm{perltime}
	    and _parse_time_absolute_use_perltime()
	    and $last_time_set = _apply_perltime( $last_time_set );
	$initial_time_set = $last_time_set;
	}
    }

    sub _apply_perltime {
	my ( $time ) = @_;
	my @t = gmtime $time;
	$t[5] += 1900;
	return greg_time_local( @t );
    }

#	Reset the last time set.

    sub _parse_time_reset {$last_time_set = $initial_time_set}

}	# End local symbol block.

#	$seconds_since_epoch = _parse_time_absolute( $string )

#	Parse the given time using the first of the following mechanisms

script/satpass  view on Meta::CPAN

    };
}

#	@tree = _parse_xml ($data, $command_name)

#	Parses the given $data as XML, using either XML::Parser or
#	XML::Parser::Lite, whichever is the first one that can be
#	loaded. The $command_name argument is optional, and is used
#	only for _load_module's error reporting.

sub _parse_xml {
    my $data = shift;

    my $xml_parser = _load_module (
	['XML::Parser', 'XML::Parser::Lite'], @_);

    my $root;
    my @tree;

    my $psr = $xml_parser->new (
	Handlers => {
	    Init => sub {
		$root = [];
		@tree = ($root);
	    },
	    Start => sub {
		shift;
		my $tag = shift;
		my $item = [$tag, {@_}];
		push @{$tree[$#tree]}, $item;
		push @tree, $item;
	    },
	    Char => sub {
		push @{$tree[$#tree]}, $_[1];
	    },
	    End => sub {
		my $tag = $_[1];
		die <<eod unless @tree > 1;
Error - Unmatched end tag </$tag>
eod
		die <<eod unless $tag eq $tree[$#tree][0];
Error - End tag </$tag> does not match start tag <$tree[$#tree][0]>
eod
		pop @tree;
	    },
	    Final => sub {
		_strip_empty_xml ($root);
		@$root;
	    },
	});

    $psr->parse ($data);
}

#	$quoted = _quoter ($string)

#	Quotes and escapes the input string if and as necessary for parser.

sub _quoter {
my $string = shift;
return $string if looks_like_number ($string);
return "''" unless $string;
return $string unless $string =~ m/[\s'"]/;
$string =~ s/([\\'])/\\$1/g;
return "'$string'";
}

#	$string = _rad2hms ($angle)

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

sub _rad2hms {
my $sec = shift (@_) / PI * 12;
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);
$rslt;
}

#	@data = _select_matching_bodies (\@data, \@choose);
#	takes as input a reference to a list of data and a reference
#	to a list of names or numbers to choose.
#	The data list is composed of Astro::Coord::ECI objects.
#	The choice list is numbers or names, the latter being rendered
#	as case-insensitive regular expressions.
#
#	All this really does is to delegate to _select_matching_data,
#	after manufacturing the correct first argument.

sub _select_matching_bodies {
    ($_[1] && @{$_[1]}) ?
	_select_matching_data (
	    [map {[$_->get ('id'), $_->get ('name') || '', $_]} @{$_[0]}],
	    $_[1]) : @{$_[0]}
}

#	@data = _select_matching_data (\@data, \@choose);
#	takes as input a reference to a list of data and a reference
#	to a list of names or numbers to choose.
#	The data list is composed of three-element list references:
#	item 0 is the ID number, item 1 is the name, and item 2 is
#	the object having that number and name.
#	The choice list is numbers or names, the latter being rendered
#	as case-insensitive regular expressions.

sub _select_matching_data {
    my ($data, $choose) = @_;
    my @keep;
    if ($choose && @$choose) {
	my %want;
	my @check = map {
	    m/\D/ || length $_ < 4 || $want{$_}++;
	    qr{$_}i}
	    map {split '\s*,\s*', $_} @$choose;
	foreach my $tle (@$data) {
	    $want{$tle->[0]} and do {push @keep, $tle->[2]; last};
	    foreach my $test (@check) {
		$tle->[1] =~ m/$test/ or next;

script/satpass  view on Meta::CPAN

sub _storable {
eval {require Storable} or die <<eod;
Error - Storable module not available.
eod
my $fn = shift or die <<eod;
Error - No file name specified.
eod
_tilde_expand ($fn);
}

#	_strip_empty_xml (\@tree)
#
#	splices out anything in the tree that is not a reference and
#	does not match m/\S/. It would be more natural to do this in
#	the Char handler, but I can't figure out how to preserve the
#	regular expression context XML::Parser::Lite needs.

sub _strip_empty_xml {
    my $ref = shift;
    my $inx = @$ref;
    while (--$inx >= 0) {
	my $val = $ref->[$inx];
	my $typ = ref $val;
	if ( ARRAY_REF eq $typ ) {
	    _strip_empty_xml ($val);
	} elsif (!$typ) {
	    splice @$ref, $inx, 1 unless $val =~ m/\S/ms;
	}
    }
}

#	$value = _sub_arg ($spec, $default, \@args)

#	This subroutine figures out what to substitute into a
#	macro being expanded, given the thing being substituted,
#	the default, and a list of the arguments provided.
#
#	If $spec is an unsigned integer, it returns the corresponding
#	element of the @args list (numbered FROM 1) if that argument
#	is defined, otherwise you get the default.
#
#	If $spec is the name of a parameter, you get that parameter's
#	value.
#
#	If $spec is the name of an environment variable, you get that
#	environment variable's value.
#
#	If all else fails, you get the default.

sub _sub_arg {
my ($name, $dflt, $args) = @_;
$dflt = '' unless defined $dflt;
my $ctrl = $dflt =~ s/^(\W)// ? $1 : '-';
my $val = $name !~ m/\D/ ? $args->[$name - 1] :
    exists $mutator{$name} ? $parm{$name} : $ENV{$name};
my $rslt;
if ($ctrl eq '+') {
    $rslt = defined $val ? $dflt : '';
    }
  elsif ($val || looks_like_number $val) {
    $rslt = $val;
    }
  elsif ($ctrl eq '-') {
    $rslt = $dflt;
    }
  elsif ($ctrl eq '=') {
    if ($name !~ m/\D/) {
	$args->[$name - 1] = $dflt;
	$rslt = $dflt;
	}
      elsif (exists $mutator{$name}) {
	set ($name, $dflt);
	$rslt = $parm{$name};
	}
      else {
	$ENV{$name} = $dflt;
	$rslt = $dflt;
	}
    }
  elsif ($ctrl eq '?') {
    die "$dflt\n";
    }
  else {
    die "Unrecognized substitution control character '$ctrl'\n";
    }
$rslt;
}

#	$expand = _tilde_expand ($filename)

#	Perform tilde expansion on the given filename if needed.

sub _tilde_expand {
    (my $rslt = $_[0] || '') =~ s%^~(\w*)%
	$1 ? do {
	    my @info = eval {getpwnam ($1)} or die $@ ?
		"Error - '~user' does not work under $^O.\n" :
		"Error - No such user as '$1'.\n";
	    $info[7]
	} :
	$^O eq 'VMS' ? '/sys$login' : ($ENV{HOME} || $ENV{LOGDIR} ||
	    $ENV{USERPROFILE})%e;
    $rslt
}

#	$time = _time ()

#	The first time this is called, it attempts to load Time::HiRes.
#	If it succeeds it redefines itself to Time::HiRes::time if that
#	exists. Otherwise it redefines itself to CORE::time. Either
#	way it then transfers control to its redefined self.

sub _time () {
    eval "use Time::HiRes";
    no warnings qw{redefine};
    if (my $code = Time::HiRes->can ('time')) {
	*_time = $code;
	*_time_trim = sub {sprintf '%.3f', $_[0]};
    } else {
	*_time = \&CORE::time;

script/satpass  view on Meta::CPAN

 satpass> # Finally, predict the flares. Include spares.
 satpass> flare -spare now +2

=item geocode

 satpass> geocode location country_code

This command attempts to look up the latitude and longitude of the
given location in the given country. The country is an ISO 3166
two-character country code, and defaults to the contents of the
L<country|/country> parameter.

This command actually works by dispatching to one of the following
geocode_* commands, which may also be invoked explicitly. In fact,
it is the existence of such a command that makes a given country
code work.

If a single location is found, the latitude and longitude parameters
will be set. The location parameter will also be set if it was not
defaulted. In addition, if the L<autoheight|/autoheight> parameter is
asserted the L<height|/height> command will be issued with the latitude
and longitude defaulted, and the effective country code used for the
geocode lookup.

Yes, it would be nice to simply parse the country code off the end
of the location, but unfortunately there are many conflicts between
the ISO 3166 country codes and the U.S. Postal Service state codes
and Canadian province codes, ranging from AL (either Albania or
Alabama) through PE (either Peru or Prince Edward Island) to VA
(either Vatican City or Virginia).

In addition to the global options, the following additional options
are available:

-height causes the command to behave as though the
L<autoheight|/autoheight> parameter were complemented. That is, it
causes the height command to be issued if autoheight is false, and
vice versa.

Also, any options legal for the height command are legal, and will be
passed through to it.

The above options are also available on all of the 'geocode_*' commands.

=item geocode_as

 satpass> geocode_as location

American Samoa is handled by L<geocode_us|/geocode_us>.

=item geocode_ca

 satpass> geocode_ca location

B<Notice:> This command is unsupported as of satpass 0.021, and
probably will not work anyway, since geocoder.ca has started
requiring registration to use its free port.

This command attempts to look up the given location (either street
address or street intersection) at L<http://geocoder.ca/>. The results
of the lookup are displayed. If no location is specified, it looks up
the value of the L<location|/location> parameter.

If exactly one valid result is returned, the latitude and longitude
of the observer are set to the returned values, and the name of
the location of the observer is set to the location passed to the
command.

If the location contains whitespace, it must be quoted. Example:

 satpass> geocode_ca '80 wellington st ottawa on'

Because of restrictions on the use of the Geocoder.ca site, you may not
use this command for commercial purposes.

=item geocode_fm

 satpass> geocode_fm location

The Federated States of Micronesia are handled by
L<geocode_us|/geocode_us>.

=item geocode_gu

 satpass> geocode_gu location

Guam is handled by L<geocode_us|/geocode_us>.

=item geocode_mh

 satpass> geocode_mh location

The Marshall Islands are handled by L<geocode_us|/geocode_us>.

=item geocode_mp

 satpass> geocode_mp location

The Northern Mariana Islands are handled by L<geocode_us|/geocode_us>.

=item geocode_pr

 satpass> geocode_pr location

Puerto Rico is handled by L<geocode_us|/geocode_us>.

=item geocode_pw

 satpass> geocode_pw location

Palau is handled by L<geocode_us|/geocode_us>.

=item geocode_us

 satpass> geocode_us location

This command attempts to look up the given location (either street
address or street intersection) in Open Street Maps. The results
of the lookup are displayed. If no location is specified, it looks up
the value of the L<location|/location> parameter.

If exactly one valid result is returned, the latitude and longitude
of the observer are set to the returned values, and the name of
the location of the observer is set to the canonical name of the
location as returned by Open Street Maps. Also, the height command is
implicitly invoked to attempt to acquire the height above sea level
provided the L<autoheight|/autoheight> parameter is true.

In addition to the usual qualifiers, this command supports the -height
qualifier, which reverses the action of the L<autoheight|/autoheight>
parameter for the command on which it is specified.

If the location contains whitespace, it must be quoted. Example:

 satpass> geocode_us '1600 pennsylvania ave washington dc'

Because of restrictions on the use of the Geocoder.us site, you may not
use this command for commercial purposes.

If you wish to use this command, you must install the
B<Geo::Coder::OSM> module.

=item geocode_vi

 satpass> geocode_vi location

The U.S. Virgin Islands are handled by L<geocode_us|/geocode_us>.

=item height

 satpass> height latitude longitude country

This command attempts to look up the height above sea level at the
given latitude and longitude in the given country. The country is an
ISO 3166 two-character country code, and defaults to the contents of the
L<country|/country> parameter.

Yes, technically country is redundant given latitude and longitude, but
I lacked a means to take advantage of this in practice.

This command actually works by dispatching to one of the following
height_* commands, which may also be invoked explicitly. In fact,
it is the existence of such a command that makes a given country
code work.

The latitude and longitude can be omitted, in which case the current
L<latitude|/latitude> and L<longitude|/longitude> parameters are
used.

In addition to the global options, the following options are available
for this command:

-all causes all results to be fetched, rather than just the 'best' one.
This probably makes no difference in the value you get, since the
results are assumed to be in descending order of goodness, and we
return the first one.

-retry_on_zero specifies the number of times to retry the query if the
result is zero. The default is 0, but you can specify more.