view release on metacpan or  search on metacpan

lib/Astro/App/Satpass2.pm  view on Meta::CPAN

    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;