File Coverage

inc/Mock/LWP/UserAgent.pm

Criterion	Covered	Total	%
statement	92	96	95.8
branch	9	14	64.2
condition	1	3	33.3
subroutine	23	25	92.0
pod			n/a
total	125	138	90.5

package Mock::LWP::UserAgent;

use 5.006002;

use strict;
use warnings;

use Carp;
use Digest::MD5 ();
use File::Spec;
use HTTP::Request;
use HTTP::Response;
use LWP::UserAgent;
use JSON;

our $VERSION = '0.161_01';

our $CANNED_RESPONSE_DIR = File::Spec->catdir(
    qw{ t data Mock-LWP-UserAgent } );

our $LOG_FILE_NAME = $ENV{MOCK_LWP_USERAGENT_LOG_FILE_NAME};

use constant HASH_REF	=> ref {};

$LOG_FILE_NAME
    and eval {
    require Test::More;
    1;
} or $LOG_FILE_NAME = undef;

## my %original = map { $_ => LWP::UserAgent->can( $_ ) } qw{
##     new cookie_jar env_proxy get head post put request
## };

sub import {

    $Astro::SpaceTrack::SPACETRACK_DELAY_SECONDS = 0;

    no warnings qw{ redefine };

    *LWP::UserAgent::new = sub {
	my ( $class ) = @_;
	return bless {
	    json	=> JSON->new()->utf8()->pretty()->canonical(),
	}, ref $class || $class;
    };

    *LWP::UserAgent::cookie_jar = sub {
	my ( $self, $data ) = @_;
	my $old = $self->{cookie_jar};
	if ( $data ) {
	    if ( HASH_REF eq ref $data ) {
		require HTTP::Cookies;
		$data = HTTP::Cookies->new( %{ $data } );
	    }
	    $self->{cookie_jar} = $data;
	}
	return $old;
    };

    *LWP::UserAgent::env_proxy = sub {
	return;
    };

    *LWP::UserAgent::get = sub {
	my ( $self, $url ) = @_;
	return _fetch( $self, GET => $url );
    };

    *LWP::UserAgent::head = sub {
	my ( $self, $url ) = @_;
	return _fetch( $self, HEAD => $url );
    };

    *LWP::UserAgent::post = sub {
	my ( $self, $url ) = @_;
	return _fetch( $self, POST => $url );
    };

    *LWP::UserAgent::put = sub {
	my ( $self, $url ) = @_;
	return _fetch( $self, PUT => $url );
    };

    *LWP::UserAgent::request = sub {
	my ( $self, $rqst ) = @_;
	my $method = $rqst->method();
	my $url = $rqst->url();
	my $path = __file_name_for( $method, $url );
	$LOG_FILE_NAME
	    and Test::More::diag( "Reading $path\n    for $method $url" );
	-f $path
	    or return _fail( $rqst, 404, "File $path not found" );
	local $/ = undef;
	open my $fh, '<:encoding(utf-8)', $path
	    or return _fail( $rqst, 500, "Failed to open $path: $!" );
	my $input = <$fh>;
	close $fh;
	my @data;
	eval {
	    @data = @{ $self->{json}->decode( $input ) };
	    1;
	} or return _fail( $rqst, 500, "Failed to decode content of $path: $@" );
	my $resp = HTTP::Response->new( @data[ 0 .. 3 ] );
	$resp->request( $rqst );
	if ( my $jar = $self->cookie_jar() ) {
	    $jar->extract_cookies( $resp );
	}
	return $resp;
    };

}

sub _fail {
    my ( $rqst, $code, $msg ) = @_;
    my $resp = HTTP::Response->new( $code, $msg );
    $resp->request( $rqst );
    return $resp;
}

sub _fetch {
    my ( $self, $method, $url ) = @_;
    my $rqst = HTTP::Request->new( $method, $url );
    return $self->request( $rqst );
}

sub __file_name_for {
    my ( $method, $url ) = @_;
    return File::Spec->catfile(
	$CANNED_RESPONSE_DIR,
	Digest::MD5::md5_hex( "$method-$url" ) . '.json',
    );
}

1;

__END__