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.182';

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 );

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

    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;
}

1;

__END__

=head1 NAME

Mock::LWP::UserAgent - Mock version of Mock::LWP::UserAgent

=head1 SYNOPSIS

 use Mock::LWP::UserAgent;
 Mock::LWP::UserAgent->install_mock();

 my $ua = LWP::UserAgent->new();
 my $resp = $ua->get( $url );	# From the mock object's database.

or, to have the support routines but have a working C<LWP::UserAgent>,

 use Mock::LWP::UserAgent;

=head1 DESCRIPTION

THIS CLASS IS PRIVATE TO THE C<Astro-SpaceTrack> DISTRIBUTION. It may be
modified or revoked at any time, without notice. Documentation is for
the benefit of the author.

If L<install_mock()|/install_mock> is called, this class mocks the
salient features of the L<LWP::UserAgent|LWP::UserAgent> interface. But
all responses are canned.

By default the responses are stored in
F<t/data/Mock-LWP-UserAgent/resp.json>, but this can be changed by
localizing C<$Mock::LWP::UserAgent::CANNED_RESPONSE_FILE> and storing
the path to the desired file in it B<before> instantiating
L<LWP::UserAgent|LWP::UserAgent>.

The canned response file is a JSON representaton of a hash keyed by URL
and, within URL, by HTTP method (C<GET>, C<POST>, and so on). The actual
responses are four-element arrays that constitute the arguments to
C<< HTTP::Response->new() >>.

Assuming the given file can be opened, read, and decoded, any request
will be satisfied by an L<HTTP::Response|HTTP::Response> object
generated from the data in the file. If the URL and method do not appear
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