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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
use strict;
use warnings;
use Test::More;
use LWP::UserAgent;
use HTTP::Request ();
plan tests => 6;
# 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};
# we can only use HTTP::Request >= 6.07
my $ver = $HTTP::Request::VERSION || '6.00';
my $ver_ok = eval {HTTP::Request->VERSION("6.07");};
my $patch_ver_ok = eval {HTTP::Request->VERSION("6.12");};
diag "Some tests for the PUT/PATCH methods can only be run on ";
diag "HTTP::Request version 6.07/6.12 or higher.";
diag "If your version isn't good enough, we'll skip those.";
diag "Your version is $ver and that's ". ($ver_ok ? '' : 'not '). 'good enough';
# default_header 'Content-Type' should be honored in POST/PUT
# if the "Content => 'string'" form is used. Otherwise, x-www-form-urlencoded
# will be used
my $url = "http://www.example.com";
my $ua = LWP::UserAgent->new;
$ua->default_header('Content-Type' => 'application/json');
$ua->proxy(http => "loopback:");
$ua->agent("foo/0.1");
# These forms will all be x-www-form-urlencoded
subtest 'PATCH x-www-form-urlencoded' => sub {
plan skip_all => "HTTP::Request version not high enough" unless $patch_ver_ok;
plan tests => 4;
for my $arg (
[ { cat => 'dog' } ],
[ [ cat => 'dog' ] ],
[ Content => { cat => 'dog' }, ],
[ Content => [ cat => 'dog' ], ],
) {
is ($ua->patch($url, @$arg)->content, <<"EOT", "patch @$arg");
PATCH http://www.example.com
User-Agent: foo/0.1
Content-Length: 7
Content-Type: application/x-www-form-urlencoded
cat=dog
EOT
}
};
# These forms will all be x-www-form-urlencoded
subtest 'PUT x-www-form-urlencoded' => sub {
plan skip_all => "HTTP::Request version not high enough" unless $ver_ok;
plan tests => 4;
for my $arg (
[ { cat => 'dog' } ],
[ [ cat => 'dog' ] ],
[ Content => { cat => 'dog' }, ],
[ Content => [ cat => 'dog' ], ],
) {
is ($ua->put($url, @$arg)->content, <<"EOT", "put @$arg");
PUT http://www.example.com
User-Agent: foo/0.1
Content-Length: 7
Content-Type: application/x-www-form-urlencoded
cat=dog
EOT
}
};
# These forms will all be x-www-form-urlencoded
subtest 'POST x-www-form-urlencoded' => sub {
plan tests => 4;
for my $arg (
[ { cat => 'dog' } ],
[ [ cat => 'dog' ] ],
[ Content => { cat => 'dog' }, ],
[ Content => [ cat => 'dog' ], ],
) {
is ($ua->post($url, @$arg)->content, <<"EOT", "post @$arg");
POST http://www.example.com
User-Agent: foo/0.1
Content-Length: 7
Content-Type: application/x-www-form-urlencoded
cat=dog
EOT
}
};
# These should all use the default
for my $call (qw(post put patch)) {
my $ucall = uc $call;
my $arg = [ Content => '{"cat":"dog"}' ];
is ($ua->$call($url, @$arg)->content, <<"EOT", "$call @$arg");
$ucall http://www.example.com
User-Agent: foo/0.1
Content-Length: 13
Content-Type: application/json
{"cat":"dog"}
EOT
}
|
