File Coverage

blib/lib/Mock/LWP/Request.pm

Criterion	Covered	Total	%
statement	42	48	87.5
branch	7	12	58.3
condition	1	3	33.3
subroutine	12	14	85.7
pod	3	4	75.0
total	65	81	80.2

package Mock::LWP::Request;

use strict;
use warnings;

our $VERSION = '0.01';

use Moo;
use HTTP::Status    qw( :constants );
use HTTP::Response;

has old_lwp_request => (
    is          => 'ro',
    init_arg    => undef,
    default     => sub {
        return \&LWP::UserAgent::request;
    },
);

has default_response => (
    is          => 'rw',
    isa         => sub {
        die "default_response must be a HTTP::Response object"
            unless (ref $_[0] && ref $_[0] eq 'HTTP::Response');
    },
    default     => sub {
        return HTTP::Response->new( HTTP_PRECONDITION_FAILED );
    },
);

has missing_response_action => (
    is          => 'rw',
    isa         => sub {
        die "missing_response_action must be either die or default"
            unless $_[0] eq 'die' || $_[0] eq 'default';
    },
    default     => sub {
        return 'die';
    },
);

has response_list => (
    is          => 'rw',
    isa         => sub {
        die "$_[0] is not an ARRAY ref"
            unless ( ref $_[0] && ref $_[0] eq 'ARRAY' );
    },
    default     => sub { return []; },
);

has enabled => (
    is          => 'rwp',
    init_arg    => undef,
    default     => sub { return 0; },
);

has debug => (
    is          => 'rw',
    default     => sub { return 0; },
);

sub enable {
    my $self = shift;

    return if $self->enabled;

    no warnings 'redefine';
    *LWP::UserAgent::request = sub {
        my $class = shift;

        warn "IN REDEFINED LWP::UserAgent::request" if $self->debug;

        my $response = shift @{ $self->response_list };
        return $response if defined $response;
        die "No response" if $self->missing_response_action eq 'die';
        return $self->default_response;
    };
    use warnings 'redefine';
    $self->_set_enabled(1);
}

sub disable {
    my $self = shift;

    return unless $self->enabled;

    no warnings 'redefine';
    *LWP::UserAgent::request = $self->old_lwp_request;
    use warnings 'redefine';
    $self->_set_enabled(0);
}

sub add_response {
    my ($self, $response) = @_;

    die "Response must be a HTTP::Response object"
        unless ref $response && ref $response eq 'HTTP::Response';

    push @{ $self->response_list }, $response;
}

sub DEMOLISH {
    my $self = shift;

    $self->disable();
}

1;
__END__