view release on metacpan or  search on metacpan

lib/Astro/SpaceTrack.pm  view on Meta::CPAN

sub _accumulate_tle_data {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ( undef, $content, $context ) = @_;	# Invocant unused
    $context->{data} .= $content;
    return;
}

# Accessed via __PACKAGE__->can( "accumulate_${name}_data" ) in
# _accumulator_for(), above
sub _accumulate_xml_data {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ( undef, $content, $context ) = @_;
    if ( defined $context->{data} ) {
	$context->{data} =~ s{ \s* </xml> \s* \z }{}smx;
	$content =~ s{ .* <xml> \s* }{}smx;
	$context->{data} .= $content;
    } else {
	$context->{data} = $content;
    }
    return;
}

# _check_cookie_generic looks for our session cookie. If it is found, it
# returns true if it thinks the cookie is valid, and false otherwise. If
# it is not found, it returns false.

sub _record_cookie_generic {
    my ( $self, $version ) = @_;
    defined $version
	or $version = $self->{space_track_version};
    my $interface_info = $self->{_space_track_interface}[$version];
    my $cookie_name = $interface_info->{cookie_name};
    my $domain = $interface_info->{domain_space_track};

    my ( $cookie, $expires );
    $self->_get_agent()->cookie_jar->scan( sub {
	    $self->{dump_headers} & DUMP_COOKIE
		and $self->_dump_cookie( "_record_cookie_generic:\n", @_ );
	    $_[4] eq $domain
		or return;
	    $_[3] eq SESSION_PATH
		or return;
	    $_[1] eq $cookie_name
		or return;
	    ( $cookie, $expires ) = @_[2, 8];
	    return;
	} );

    # I don't get an expiration time back from the version 2 interface.
    # But the docs say the cookie is only good for about two hours, so
    # to be on the safe side I fudge in an hour.
    $version == 2
	and not defined $expires
	and $expires = time + 3600;

    if ( defined $cookie ) {
	$interface_info->{session_cookie} = $cookie;
	$self->{dump_headers} & DUMP_TRACE
	    and warn "Session cookie: $cookie\n";	## no critic (RequireCarping)
	if ( exists $interface_info->{cookie_expires} ) {
	    $interface_info->{cookie_expires} = $expires;
	    $self->{dump_headers} & DUMP_TRACE
		and warn 'Cookie expiration: ',
		    POSIX::strftime( '%d-%b-%Y %H:%M:%S', localtime $expires ),
		    " ($expires)\n";	## no critic (RequireCarping)
	    return $expires > time;
	}
	return $interface_info->{session_cookie} ? 1 : 0;
    } else {
	$self->{dump_headers} & DUMP_TRACE
	    and warn "Session cookie not found\n";	## no critic (RequireCarping)
	return;
    }
}

sub _check_cookie_generic {
    my ( $self, $version ) = @_;
    defined $version
	or $version = $self->{space_track_version};
    my $interface_info = $self->{_space_track_interface}[$version];

    if ( exists $interface_info->{cookie_expires} ) {
	return defined $interface_info->{cookie_expires}
	    && $interface_info->{cookie_expires} > time;
    } else {
	return defined $interface_info->{session_cookie};
    }
}

#	_convert_content converts the content of an HTTP::Response
#	from crlf-delimited to lf-delimited.

{	# Begin local symbol block

    my $lookfor = $^O eq 'MacOS' ? qr{ \012|\015+ }smx : qr{ \r \n }smx;

    sub _convert_content {
	my ( undef, @args ) = @_;	# Invocant unused
	local $/ = undef;	# Slurp mode.
	foreach my $resp (@args) {
	    my $buffer = $resp->content;
	    # If we request a non-existent Space Track catalog number,
	    # we get 200 OK but the unzipped content is undefined. We
	    # catch this before we get this far, but the buffer check is
	    # left in in case something else leaks through.
	    defined $buffer or $buffer = '';
	    $buffer =~ s/$lookfor/\n/smxgo;
	    1 while ($buffer =~ s/ \A \n+ //smx);
	    $buffer =~ s/ \s+ \n /\n/smxg;
	    $buffer =~ m/ \n \z /smx or $buffer .= "\n";
	    $resp->content ($buffer);
	    $resp->header (
		'content-length' => length ($buffer),
		);
	}
	return;
    }
}	# End local symbol block.

#	$self->_deprecation_notice( $method, $argument );
#
#	This method centralizes deprecation.  Deprecation is driven of
#	the %deprecate hash. Values are:

lib/Astro/SpaceTrack.pm  view on Meta::CPAN

	},
	iridium_status	=> _MASTER_IRIDIUM_DEPRECATION_LEVEL,
	iridium_status_format	=> {
	    kelso	=> 3,
	    mccants	=> 3,
	    sladen	=> _MASTER_IRIDIUM_DEPRECATION_LEVEL,
	},
	option => {
	    last5	=> 2,
	},
	mccants	=> {
	    mcnames	=> 3,
	    quicksat	=> 3,
	    vsnames	=> 3,
	},
	BODY_STATUS_IS_OPERATIONAL	=> _MASTER_IRIDIUM_DEPRECATION_LEVEL,
	BODY_STATUS_IS_SPARE	=> _MASTER_IRIDIUM_DEPRECATION_LEVEL,
	BODY_STATUS_IS_TUMBLING	=> _MASTER_IRIDIUM_DEPRECATION_LEVEL,
	BODY_STATUS_IS_DECAYED	=> _MASTER_IRIDIUM_DEPRECATION_LEVEL,
	spacetrack => {
	    navigation => _MASTER_FAVORITE_DEPRECATION_LEVEL,
	    weather => _MASTER_FAVORITE_DEPRECATION_LEVEL,
	    amateur => _MASTER_FAVORITE_DEPRECATION_LEVEL,
	    visible => _MASTER_FAVORITE_DEPRECATION_LEVEL,
	    special => _MASTER_FAVORITE_DEPRECATION_LEVEL,
	    bright_geosynchronous => _MASTER_FAVORITE_DEPRECATION_LEVEL,
	    human_spaceflight => _MASTER_FAVORITE_DEPRECATION_LEVEL,
	},
    );

    sub _deprecation_notice {
	my ( undef, $method, $argument ) = @_;	# Invocant unused
	defined $method
	    or ( $method = ( caller 1 )[3] ) =~ s/ .* :: //smx;
	my $level = $deprecate{$method}
	    or return;
	my $desc = $method;
	if ( ref $level ) {
	    defined $argument or Carp::confess( 'Bug - $argument undefined' );
	    $level = $level->{$argument}
		or return;
	    $desc = "$method $argument";
	}
	$level >= 3
	    and Carp::croak "$desc is retracted";
	warnings::enabled( 'deprecated' )
	    and Carp::carp "$desc is deprecated";
	1 == $level
	    or return;
	if ( ref $deprecate{$method} ) {
	    $deprecate{$method}{$argument} = 0;
	} else {
	    $deprecate{$method} = 0;
	}
	return;
    }

}

#	_dump_cookie is intended to be called from inside the
#	HTTP::Cookie->scan method. The first argument is prefix text
#	for the dump, and the subsequent arguments are the arguments
#	passed to the scan method.
#	It dumps the contents of the cookie to STDERR via a warn ().
#	A typical session cookie looks like this:
#	    version => 0
#	    key => 'spacetrack_session'
#	    val => whatever
#	    path => '/'
#	    domain => 'www.space-track.org'
#	    port => undef
#	    path_spec => 1
#	    secure => undef
#	    expires => undef
#	    discard => 1
#	    hash => {}
#	The response to the login, though, has an actual expiration
#	time, which we take cognisance of.

{	# begin local symbol block

    my @names = qw{version key val path domain port path_spec secure
	    expires discard hash};

    sub _dump_cookie {
	my ( $self, $prefix, @args ) = @_;
	my $json = $self->_get_json_object( pretty => 1 );
	$prefix and warn $prefix;	## no critic (RequireCarping)
	for (my $inx = 0; $inx < @names; $inx++) {
	    warn "    $names[$inx] => ", $json->encode( $args[$inx] ); ## no critic (RequireCarping)
	}
	return;
    }
}	# end local symbol block


#	__dump_response dumps the headers of the passed-in response
#	object. The hook is used for capturing responses to use when
#	mocking LWP::UserAgent, and is UNSUPPORTED, and subject to
#	change or retraction without notice.

sub __dump_response {
    my ( $self, $resp, $message ) = @_;

    if ( $self->{dump_headers} & DUMP_RESPONSE ) {
	my $content = $resp->content();
	if ( $self->{dump_headers} & DUMP_TRUNCATED
	    && 61 < length $content ) {
	    $content = substr( $content, 0, 61 ) . '...';
	}
	my @data = ( $resp->code(), $resp->message(), [], $content );
	foreach my $name ( $resp->headers()->header_field_names() ) {
	    my @val = $resp->header( $name );
	    push @{ $data[2] }, $name, @val > 1 ? \@val : $val[0];
	}
	if ( my $rqst = $resp->request() ) {
	    push @data, {
		method	=> $rqst->method(),
		uri	=> '' . $rqst->uri(),	# Force stringification
	    };
	}