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();
    my $data;
    if ( open my $fh, '<:encoding(utf-8)', $path ) {
	local $/ = undef;	# Slurp mode
	$data = $json->decode( scalar <$fh> );
	close $fh;
    } elsif ( $arg{optional} && $! == ENOENT ) {
	$data = {};
    } else {
	croak "Failed to open $path: $!";
    }
    return +{
	path	=> $path,
	data	=> $data,
    };
}

sub __modify_data {
    my ( $data, $url, $method, $resp ) = @_;
    $data->{data}{$url}{$method} = $resp;
    my $path = $data->{path};
    my $json = JSON->new()->pretty()->canonical();
    open my $fh, '>:encoding(utf-8)', $path
	or croak "Unable to modify $path: $!";
    print { $fh } $json->encode( $data->{data} );
    close $fh;
    return;
}

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

in the file, a 404 response is generated.

=head1 METHODS

This class supports the following public method:

=head2 install_mock

This static method sets C<$Astro::SpaceTrack::SPACETRACK_DELAY_SECONDS>
to zero. It also hot-patches the following
L<LWP::UserAgent|LWP::UserAgent> methods:

=head3 new

 my $ua = LWP::UserAgent->new();

This static method instantiates the object.

It calls subroutine (B<not> method) L<__load_data()|/__load_data> to
populate the canned data.

=head3 env_proxy

 $ua->env_proxy();

This method does nothing.

=head3 get

 my $resp = $ua->get( $url );

This method returns the response for a GET request on the given URL.
The heavy lifting is done by L<request()|/request>.

=head3 head

 my $resp = $ua->head( $url );

This method returns the response for a HEAD request on the given URL.
The heavy lifting is done by L<request()|/request>.

=head3 post

 my $resp = $ua->post( $url );

This method returns the response for a POST request on the given URL.
The heavy lifting is done by L<request()|/request>.

=head3 put

 my $resp = $ua->put( $url );

This method returns the response for a PUT request on the given URL.
The heavy lifting is done by L<request()|/request>.

=head3 request

 my $resp = $ua->request( $rqst );

This method returns the response for the given
L<HTTP::Request|HTTP::Request> object from the data loaded by
L<__load_data()|/__load_data>. If the given URL and method are not
found, the response is a 404 error.

=head1 ATTRIBUTES

This class has no public attributes.

=head1 SUBROUTINES

This class also has a couple old-school subroutines to manage its data.
These are unsupported, and documented solely for the convenience of the
author.

=head2 __load_data

This subroutine loads data from a JSON file and returns a reference to a
two-element hash. Key C<{path}> contains the path to the file, and key
C<{data}> contains the data in the file, after it has been decoded from
JSON.

The path to the file comes from
C<$Mock::LWP::UserAgent::CANNED_DATA_FILE>. If that is C<undef> (which
it is by default), F<t/data/Mock-LWP-UserAgent/resp.json> is read.

Optional arguments can be specified as name/value pairs. The following
arguments are supported:

=over

=item optional

If this Boolean argument is true, the file need not exist, and if it
does not the returned data hash will be empty.

If this Boolean argument is false, or is not specified, a missing file
is an error.

=back

All other arguments are unsupported, and behavior if specified may
change without notice.

=head2 __modify_data

This subroutine takes four arguments. These are:

=over

=item 1) The data returned by L<__load_data()|/__load_data>;

=item 2) The URL being recorded;

=item 3) The method by which the URL was fetched

=item 4) An array reference containing the desired arguments to C<new()> to construct the response.

=back

The response is stored in the data, which are then rewritten to the
file.