1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
|
use strict;
use warnings;
use Test::More;
use LWP::UserAgent ();
use HTTP::Request ();
use HTTP::Response ();
# Prevent environment from interfering with test:
delete $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME};
delete $ENV{HTTPS_CA_FILE};
delete $ENV{HTTPS_CA_DIR};
delete $ENV{PERL_LWP_SSL_CA_FILE};
delete $ENV{PERL_LWP_SSL_CA_PATH};
delete $ENV{PERL_LWP_ENV_PROXY};
sub ua {
my $ua = LWP::UserAgent->new;
$ua->add_handler(
request_send => sub {
my ($request, $ua, $handler) = @_;
return HTTP::Response->new(200,'OK',[],'ok');
}
);
return $ua;
}
subtest 'request_send' => sub {
my $ua = ua;
my $res = $ua->get('http://www.example.com');
ok($res->is_success, 'handler should succeed');
is($res->content,'ok','handler-provided response should be used');
};
subtest 'request_prepare' => sub {
my $ua = ua;
$ua->add_handler(
request_prepare => sub {
# the docs say this is the way to replace the request
$_[0] = HTTP::Request->new(POST=>'http://mmm.example.com/');
}
);
my $res = $ua->get('http://www.example.com');
my $effective_request = $res->request;
is($effective_request->method,'POST',
'the request should have been modified by the handler');
is($effective_request->uri,'http://mmm.example.com/',
'the request should have been modified by the handler');
};
subtest 'response_redirect' => sub {
my $ua = ua;
$ua->add_handler(
response_redirect => sub {
return HTTP::Request->new(PUT => 'http://put.example.com');
}
);
my $res = $ua->get('http://www.example.com');
my $effective_request = $res->request;
is($effective_request->method,'PUT',
'the request should have been replaced by the handler');
is($effective_request->uri,'http://put.example.com',
'the request should have been replaced by the handler');
};
done_testing;
|
