File Coverage

blib/lib/Test/Mock/LWP/Dispatch.pm

Criterion	Covered	Total	%
statement	88	97	90.7
branch	32	40	80.0
condition	10	19	52.6
subroutine	16	16	100.0
pod	5	5	100.0
total	151	177	85.3

package Test::Mock::LWP::Dispatch;
$Test::Mock::LWP::Dispatch::VERSION = '0.07';
use strict;
use warnings;

# ABSTRACT: mocks LWP::UserAgent and dispatches your requests/responses


use base qw(Exporter Test::MockObject);

our @EXPORT = qw($mock_ua);
our @EXPORT_OK = @EXPORT;
our $DEFAULT_REQUEST_HEADERS = 1;

use Carp qw(croak);
use Data::Dumper qw();
use HTTP::Request;
use HTTP::Response;
use LWP::UserAgent;
use Test::MockObject;

our $mock_ua;
BEGIN {
    my $default_resp = HTTP::Response->new(404);
    my $orig_simple_request_fn = \&LWP::UserAgent::simple_request;



    sub simple_request {
        my $mo = shift;
        my $in_req = shift;
        $in_req = $mo->prepare_request($in_req)
          if ( $DEFAULT_REQUEST_HEADERS && $mo->can('prepare_request') );

        my $global_maps = $mock_ua->{_maps} || [];
        my $local_maps = $mo->{_maps} || [];
        my $matched_resp = $default_resp;
        foreach my $map (@{$local_maps}, @{$global_maps}) {
            next unless (defined($map));
            my ($req, $resp) = @{$map};

            if (ref($req) eq 'HTTP::Request') {
                $req = $mo->prepare_request($req)
                  if ( $DEFAULT_REQUEST_HEADERS && $mo->can('prepare_request') );
                my $dd = Data::Dumper->new([$in_req]);
                my $dd_in = Data::Dumper->new([$req]);
                $dd->Sortkeys(1);
                $dd_in->Sortkeys(1);
                next unless ($dd_in->Dump eq $dd->Dump);
            } elsif (ref($req) eq '') {
               next unless ($in_req->uri eq $req);
            } elsif (ref($req) eq 'Regexp') {
                next unless ($in_req->uri =~ $req);
            } elsif (ref($req) eq 'CODE') {
                next unless ($req->($in_req));
            } else {
                warn "Unknown type of predefined request: " . ref($req);
                next;
            }

            $matched_resp = $resp;
            last;
        }
        if (ref($matched_resp) eq 'HTTP::Response') {
            return $matched_resp;
        } elsif (ref($matched_resp) eq 'CODE') {
            return $matched_resp->($in_req);
        } else {
            warn "Unknown type of predefined response: " . ref($matched_resp);
            return $default_resp;
        }
    }


    sub map {
        my $mo = shift;

        my ($req, $resp) = @_;
        if (!defined($req) || !defined($resp)) {
            croak "You should pass 2 arguments in map()";
        }
        if (ref($req) !~ /^(HTTP::Request|Regexp|CODE|)$/) {
            croak "Type of request must be HTTP::Request, regexp, coderef or plain string\n";
        }
        if (ref($resp) !~ /^(HTTP::Response|CODE)$/) {
            croak "Type of response must be HTTP::Response or coderef\n";
        }

        my $map = [$req, $resp];
        push @{$mo->{_maps}}, $map;
        return scalar(@{$mo->{_maps}}) - 1;
    }


    sub map_passthrough {
        my $mo = shift;

        my ($req) = @_;
        if (!defined($req)) {
            croak "You should pass 1 argument to map_passthrough()";
        }

        return $mo->map($req, sub { return $orig_simple_request_fn->($mo, shift); });
    }


    sub unmap {
        my $mo = shift;
        my $index = shift;
        return if (!defined($index) || $index !~ /^\d+$/);
        unless ($mo->{_maps}) {
            warn "You call unmap() before any call of map()\n";
            return;
        }
        if ($index < 0 || $index > (scalar(@{$mo->{_maps}}) - 1)) {
            warn "Index $index is out of maps range\n";
            return;
        }
        delete $mo->{_maps}->[$index];
        return 1;
    }


    sub unmap_all {
        my $mo = shift;
        $mo->{_maps} = [];
        return 1;
    }

    my %mock_methods = (
         simple_request => \&simple_request,
         map            => \&map,
         map_passtrough => \&map_passthrough,
         unmap          => \&unmap,
         unmap_all      => \&unmap_all,
    );

    Test::MockObject->fake_module('LWP::UserAgent', %mock_methods);
    # The global mock object, can be used directly, or can just create a new
    # LWP::UserAgent object - that is mocked too.
    $mock_ua = LWP::UserAgent->new;
}

1;

__END__