view release on metacpan or  search on metacpan

inc/Astro/SpaceTrack/Dumper.pm  view on Meta::CPAN

		and $item->{TLE_LINE1} =~ s/
		    (?: \A | (?<= [\r\n] ) )
		    ( 1 [\s0-9]{6}U \s )
		    [^\r\n]*
		/${1}First line of data/smxg;
	    defined $item->{TLE_LINE2}
		and $item->{TLE_LINE2} =~ s/
		    (?: \A | (?<= [\r\n] ) )
		    ( 2 [\s0-9]{6} \s )
		    [^\r\n]*
		/${1}Second line of data/smxg;
	}
	return $json->encode( $a );
    }
}

# Accessed via address space scan in _list_censors()
sub _censor_tle {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ( $data ) = @_;
    $data =~ s/
	(?: \A | (?<= [\r\n] ) )
	( 1 [\s0-9]{6}U \s )
	[^\r\n]*
    /${1}First line of data/smxg
	or return;
    $data =~ s/
	(?: \A | (?<= [\r\n] ) )
	( 2 [\s0-9]{6} \s )
	[^\r\n]*
    /${1}Second line of data/smxg
	or return;
    return $data;
}

{
    my $censors;
    my $json;

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

	my $rqst = $resp->request()
	    or return;

	my $method = $rqst->method();
	my $url = $rqst->url();

	$censors ||= _list_censors();
	my $content = $resp->content();
	foreach my $code ( @{ $censors } ) {
	    defined( my $revised = $code->( $content ) )
		or next;
	    $content = $revised;
	    last;
	}
	my @data = (
	    $resp->code(),
	    $resp->message(),
	    [ 
		_dump_header_item( $resp, 'Content-Type' ),
		_dump_header_item( $resp, 'Set-Cookie',
		    "chocolatechip=This bears no relation to any cookie set by Space Track; path=/; domain=www.space-track.org",
		),
		_dump_header_item( $resp, 'Status' ),
	    ],
	    $content,
	);

	Mock::LWP::UserAgent::__modify_data(
	    $self->{ +__PACKAGE__ }, $url, $method, \@data );

	return;
    }
}

sub list {
    my ( $self ) = @_;
    my $data = $self->{ +__PACKAGE__ }{data};
    my @content;
    foreach my $url ( sort keys %{ $data } ) {
	foreach my $method ( sort keys %{ $data->{$url} } ) {
	    push @content, "$method $url\r\n";
	}
    }
    return HTTP::Response->new(
	HTTP_OK,
	undef,
	undef,
	join( '', @content ),
    );
}

sub _dump_header_item {
    my ( $resp, $name, $override ) = @_;
    my @value = $resp->header( $name )
	or return;
    defined $override
	and return ( $name => $override );
    @value > 1
	and return ( $name => \@value );
    return ( $name => $value[0] );
}

# Return an array of code references to all the methods named
# '_censor_'. If called in scalar context, return a reference to the
# array.
sub _list_censors {
    my @censors;
    my $name_space = __PACKAGE__ . '::';
    my $symbol_table;
    {
	no strict qw{ refs };
	$symbol_table = { %$name_space };
    }
    foreach my $symbol ( sort keys %{ $symbol_table } ) {
	$symbol =~ m/ \A _censor_ /smx
	    or next;
	my $code = __PACKAGE__->can( $symbol )
	    or next;
	push @censors, $code;
    }