view release on metacpan or  search on metacpan

inc/Mock/LWP/UserAgent.pm  view on Meta::CPAN

package Mock::LWP::UserAgent;

use 5.006002;

use strict;
use warnings;

use Carp;
use Errno qw{ ENOENT };
use File::Spec;
use HTTP::Request;
use HTTP::Response;
use LWP::UserAgent;
use JSON;

our $VERSION = '0.181';

our $CANNED_RESPONSE_FILE;

use constant REF_HASH	=> ref {};

sub install_mock {

    $Astro::SpaceTrack::SPACETRACK_DELAY_SECONDS = 0;

    no warnings qw{ redefine };

    *LWP::UserAgent::new = sub {
	my ( $class, @arg ) = @_;
	### my $self = $class->SUPER::new( @arg );
	my $self = bless {}, $class;
	$self->{ +__PACKAGE__ } = __load_data();
	return $self;
    };

    *LWP::UserAgent::cookie_jar = sub {
	my ( $self, $data ) = @_;
	my $old = $self->{cookie_jar};
	if ( $data ) {
	    if ( REF_HASH 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 $self->request( HTTP::Request->new( GET => $url ) );
    };

    *LWP::UserAgent::head = sub {
	my ( $self, $url ) = @_;
	return $self->request( HTTP::Request->new( HEAD => $url ) );
    };

    *LWP::UserAgent::post = sub {
	my ( $self, $url ) = @_;
	return $self->request( HTTP::Request->new( POST => $url ) );
    };

    *LWP::UserAgent::put = sub {
	my ( $self, $url ) = @_;
	return $self->request( HTTP::Request->new( PUT => $url ) );
    };

    *LWP::UserAgent::request = sub {
	my ( $self, $rqst ) = @_;
	my $method = $rqst->method();
	my $url = $rqst->url();

	my $data = $self->{ +__PACKAGE__ }{data}{$url}{$method}
	    or return _fail( $rqst, 404, "$method $url not found" );
	my $resp = HTTP::Response->new( @{ $data } );

	$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 __load_data {
    my ( %arg ) = @_;
    my $path = defined $CANNED_RESPONSE_FILE ?
	$CANNED_RESPONSE_FILE :
	File::Spec->catfile( qw{ t data Mock-LWP-UserAgent resp.json } );
    my $json = JSON->new();