Astro-SpaceTrack

 view release on metacpan or  search on metacpan

inc/My/Module/Test.pm  view on Meta::CPAN

# Set the following to zero if Space Track (or any other SSL host)
# starts using a certificate that can not be verified.
use constant VERIFY_HOSTNAME => defined $ENV{SPACETRACK_VERIFY_HOSTNAME}
    ? $ENV{SPACETRACK_VERIFY_HOSTNAME}
    : 0;

our @EXPORT =		## no critic (ProhibitAutomaticExportation)
qw{
    is_error
    is_error_or_skip
    is_not_success
    is_success
    is_success_or_skip
    last_modified
    most_recent_http_response
    not_defined
    site_check
    spacetrack_user
    spacetrack_skip_no_prompt
    skip_site
    throws_exception
    VERIFY_HOSTNAME
};

use constant HASH_REF	=> ref {};
use constant REGEXP_REF	=> ref qr{};

inc/My/Module/Test.pm  view on Meta::CPAN

    local $Test::Builder::Level = $Test::Builder::Level + 1;
    my ( $code, $name ) = splice @args, -2, 2;
    $rslt = eval { $obj->$method( @args ) };
    $rslt
	or return fail "$name threw exception: $@";
    my $got = $rslt->code();
    __skip_if_server_error( $method, $got );
    return cmp_ok $got, '==', $code, $name;
}

sub is_not_success {	## no critic (RequireArgUnpacking)
    my ( $obj, $method, @args ) = @_;
    my $name = pop @args;
    $rslt = eval { $obj->$method( @args ) };
    $rslt or do {
	@_ = ( "$name threw exception: $@" );
	goto \&fail;
    };
    @_ = ( ! $rslt->is_success(), $name );
    goto &ok;
}

inc/My/Module/Test.pm  view on Meta::CPAN

    foreach my $hdr ( $rslt->header( 'Last-Modified' ) ) {
	return str2time( $hdr );
    }
    return;
}

sub most_recent_http_response {
    return $rslt;
}

sub not_defined {
    @_ = ( ! defined $_[0], @_[1 .. $#_] );
    goto &ok;
}

# Prompt the user. DO NOT call this if $ENV{AUTOMATED_TESTING} is set.

{
    my ( $set_read_mode, $readkey_loaded );

    BEGIN {

inc/My/Module/Test.pm  view on Meta::CPAN

=head2 is_error_or_skip

 is_error $st, fubar => 42,
     404,
     'Make sure $st->fubar( 42 ) returns a 404';

This subroutine is like C<is_error(), but if the returned status is 500,
the test is skipped.

=head2 is_not_success

 is_not_success $st, fubar => 42,
     'Make sure $st->fubar( 42 ) fails';

This subroutine executes the given method and tests its result for
failure. The method is assumed to return an HTTP::Response object. The
arguments are:

  - The method's invocant
  - The method's name
  - Zero or more arguments
  - The test name

inc/My/Module/Test.pm  view on Meta::CPAN

=head2 most_recent_http_response

 my $resp = most_recent_http_response;
 $resp->is_success()
     or diag $resp->status_line();

This subroutine returns the HTTP::Response object from the most-recent
test that actually generated one.

=head2 not_defined

 not_defined $resp, 'Make sure we have a response';

This subroutine performs a test which succeeds its first argument is not
defined. The second argument is the test name.

=head2 set_skip

 set_skip 'celestrak.org';
 set_skip 'celestrak.org', 'Manually skipping';

This subroutine sets or clears the skip indicator for the given site.

t/query_misc.t  view on Meta::CPAN

my $st = Astro::SpaceTrack->new();

$st->set( webcmd => undef );

is_success( $st, 'banner', 'Get banner' );

is_success( $st, 'help', 'Get internal help' );

is $st->content_type(), 'help', "Content type is 'help'";

not_defined( $st->content_source(), "Content source is undef" );

is_success( $st, 'names', 'celestrak', 'Retrieve Celestrak catalog names' );

is_not_success( $st, 'names', 'bogus', 'Can not retrieve bogus catalog names' );

$st->set( banner => undef, filter => 1 );
$st->shell( '', '# comment', 'set banner 1', 'exit' );
ok $st->get('banner'), 'Reset an attribute using the shell';

done_testing;

1;

__END__

t/query_spacetrack.t  view on Meta::CPAN

## my $username = $st->getv( 'username' );
## my $password = $st->getv( 'password' );

SKIP: {

    is_success( $st, 'login', 'Log in to Space-Track' )
	or skip 'Not logged in', 1;

    my $rslt = HTTP::Response->new();

    not_defined( $st->content_type(), 'Content type should be undef' )
	or diag( 'content_type is ', $st->content_type() );

    not_defined( $st->content_source(), 'Content source should be undef' )
	or diag( 'content_source is ', $st->content_source() );

    not_defined( $st->content_interface(),
	    'Content interface should be undef' )
	or diag 'content_interface is ', $st->content_interface();

    not_defined( $st->content_type( $rslt ), 'Result type should be undef' )
	or diag( 'content_type is ', $st->content_type( $rslt ) );

    not_defined( $st->content_source( $rslt ),
	    'Result source should be undef' )
	or diag( 'content_source is ', $st->content_source( $rslt ) );

    not_defined( $st->content_interface( $rslt ),
	    'Result interface should be undef' )
	or diag 'content_interface is ', $st->content_interface( $rslt );

    is_error( $st, spacetrack => 'fubar',
	404, 'Fetch a non-existent catalog entry' );

    SKIP: {
	is_success_or_skip( $st, spacetrack => 'inmarsat',
	    'Fetch a catalog entry', 3 );