← Back to branch summary

~ubuntu-branches/ubuntu/dapper/libwww-perl/dapper-updates

« back to all changes in this revision

Viewing changes to t/base/message.t

  • Committer: Bazaar Package Importer
  • Author(s): Jay Bonci
  • Date: 2005-02-13 18:45:32 UTC
  • mfrom: (2.1.2 hoary)
  • Revision ID: james.westby@ubuntu.com-20050213184532-67qvopi4wre3010u
Tags: 5.803-4
http://bugs.debian.org/294597
http://bugs.debian.org/294595
* Make GET/POST/HEAD symlinks (Closes: #294597)
* lwp-requests now honors -b when dumping links (Closes: #294595)
  - Thanks to giuseppe bonacci for the patch
* Moved symlinks to a libwww-perl.links file

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/base/message.t
1
 
print "1..16\n";
2
 
 
3
 
require HTTP::Request;
4
 
require HTTP::Response;
5
 
 
6
 
require Time::Local if $^O eq "MacOS";
7
 
my $offset = ($^O eq "MacOS") ? Time::Local::timegm(0,0,0,1,0,70) : 0;
8
 
 
9
 
$req = new HTTP::Request 'GET', "http://www.sn.no/";
10
 
$req->header(
11
 
        "if-modified-since" => "Thu, 03 Feb 1994 00:00:00 GMT",
12
 
        "mime-version"      => "1.0");
13
 
 
14
 
$str = $req->as_string;
15
 
 
16
 
print $str;
17
 
 
18
 
$str =~ /^GET/m || print "not ";
19
 
print "ok 1\n";
20
 
 
21
 
$req->header("MIME-Version") eq "1.0" || print "not ";
22
 
print "ok 2\n";
23
 
 
24
 
$req->content("gisle");
25
 
$req->add_content(" aas");
26
 
$req->add_content(\ " old interface is depreciated");
27
 
 
28
 
${$req->content_ref} =~ s/\s+is\s+depreciated//;
29
 
 
30
 
print "Content is: ", $req->content, "\n";
31
 
 
32
 
$req->content eq "gisle aas old interface" || print "not ";
33
 
print "ok 3\n";
34
 
 
35
 
$req->if_modified_since == ((760233600 + $offset) | 0) || print "not ";
36
 
print "ok 4\n";
37
 
 
38
 
$time = time;
39
 
 
40
 
$req->date($time);
41
 
$timestr = gmtime($time);
42
 
($month) = ($timestr =~ /^\S+\s+(\S+)/);  # extract month;
43
 
 
44
 
print "These should represent the same time:\n\t", $req->header('Date'), "\n\t$timestr\n";
45
 
 
46
 
$req->header('Date') =~ /\Q$month/ || print "not ";
47
 
print "ok 5\n";
48
 
 
49
 
$req->authorization_basic("gisle", "passwd");
50
 
$auth = $req->header("Authorization");
51
 
 
52
 
print "$auth\n";
53
 
$auth =~ /Z2lzbGU6cGFzc3dk/ || print "not ";
54
 
print "ok 6\n";
55
 
 
56
 
($user, $pass) = $req->authorization_basic;
57
 
($user eq "gisle" && $pass eq "passwd") || print "not ";
58
 
print "ok 7\n";
59
 
 
60
 
# Check the response
61
 
$res = new HTTP::Response 200, "This message";
62
 
 
63
 
$html = $res->error_as_HTML;
64
 
print $html;
65
 
 
66
 
($html =~ /<head>/i && $html =~ /This message/) || print "not ";
67
 
print "ok 8\n";
68
 
 
69
 
$res->is_success || print "not ";
70
 
print "ok 9\n";
71
 
 
72
 
$res->content_type("text/html;version=3.0");
73
 
$res->content("<html>...</html>\n");
74
 
 
75
 
$res2 = $res->clone;
76
 
 
77
 
print $res2->as_string;
78
 
 
79
 
$res2->header("cOntent-TYPE") eq "text/html;version=3.0" || print "not ";
80
 
print "ok 10\n";
81
 
 
82
 
$res2->code == 200 || print "not ";
83
 
print "ok 11\n";
84
 
 
85
 
$res2->content =~ />\.\.\.</ || print "not ";
86
 
print "ok 12\n";
87
 
 
88
 
# Check the base method:
89
 
 
90
 
$res = new HTTP::Response 200, "This message";
91
 
$res->request($req);
92
 
$res->content_type("image/gif");
93
 
 
94
 
$res->base eq "http://www.sn.no/" || print "not ";
95
 
print "ok 13\n";
96
 
 
97
 
$res->header('Base', 'http://www.sn.no/xxx/');
98
 
 
99
 
$res->base eq "http://www.sn.no/xxx/" || print "not ";
100
 
print "ok 14\n";
101
 
 
102
 
# Check the AUTLOAD delegate method with regular expressions
103
 
"This string contains text/html" =~ /(\w+\/\w+)/;
104
 
$res->content_type($1);
105
 
 
106
 
$res->content_type eq "text/html" || print "not ";
107
 
print "ok 15\n";
108
 
 
109
 
# Check what happens when passed a new URI object
110
 
require URI;
111
 
$req = HTTP::Request->new(GET => URI->new("http://localhost"));
112
 
print "not " unless $req->uri eq "http://localhost";
113
 
print "ok 16\n";
114
 
 
 
1
#!perl -w
 
2
 
 
3
use strict;
 
4
use Test qw(plan ok skip);
 
5
 
 
6
plan tests => 92;
 
7
 
 
8
require HTTP::Message;
 
9
 
 
10
my($m, $m2, @parts);
 
11
 
 
12
$m = HTTP::Message->new;
 
13
ok($m);
 
14
ok(ref($m), "HTTP::Message");
 
15
ok(ref($m->headers), "HTTP::Headers");
 
16
ok($m->as_string, "\n");
 
17
ok($m->headers->as_string, "");
 
18
ok($m->headers_as_string, "");
 
19
ok($m->content, "");
 
20
 
 
21
$m->header("Foo", 1);
 
22
ok($m->as_string, "Foo: 1\n\n");
 
23
 
 
24
$m2 = HTTP::Message->new($m->headers);
 
25
$m2->header(bar => 2);
 
26
ok($m->as_string, "Foo: 1\n\n");
 
27
ok($m2->as_string, "Bar: 2\nFoo: 1\n\n");
 
28
 
 
29
$m2 = HTTP::Message->new($m->headers, "foo");
 
30
ok($m2->as_string, "Foo: 1\n\nfoo\n");
 
31
ok($m2->as_string("<<\n"), "Foo: 1<<\n<<\nfoo");
 
32
$m2 = HTTP::Message->new($m->headers, "foo\n");
 
33
ok($m2->as_string, "Foo: 1\n\nfoo\n");
 
34
 
 
35
$m = HTTP::Message->new([a => 1, b => 2], "abc");
 
36
ok($m->as_string, "A: 1\nB: 2\n\nabc\n");
 
37
 
 
38
$m = HTTP::Message->parse("");
 
39
ok($m->as_string, "\n");
 
40
$m = HTTP::Message->parse("\n");
 
41
ok($m->as_string, "\n");
 
42
$m = HTTP::Message->parse("\n\n");
 
43
ok($m->as_string, "\n\n");
 
44
ok($m->content, "\n");
 
45
 
 
46
$m = HTTP::Message->parse("foo");
 
47
ok($m->as_string, "\nfoo\n");
 
48
$m = HTTP::Message->parse("foo: 1");
 
49
ok($m->as_string, "Foo: 1\n\n");
 
50
$m = HTTP::Message->parse("foo: 1\n\nfoo");
 
51
ok($m->as_string, "Foo: 1\n\nfoo\n");
 
52
$m = HTTP::Message->parse(<<EOT);
 
53
FOO : 1
 
54
 2
 
55
  3
 
56
   4
 
57
bar:
 
58
 1
 
59
Baz: 1
 
60
 
 
61
foobarbaz
 
62
EOT
 
63
ok($m->as_string, <<EOT);
 
64
Bar: 
 
65
 1
 
66
Baz: 1
 
67
Foo: 1
 
68
 2
 
69
  3
 
70
   4
 
71
 
 
72
foobarbaz
 
73
EOT
 
74
 
 
75
$m = HTTP::Message->parse("  abc\nfoo: 1\n");
 
76
ok($m->as_string, "\n  abc\nfoo: 1\n");
 
77
$m = HTTP::Message->parse(" foo : 1\n");
 
78
ok($m->as_string, "\n foo : 1\n");
 
79
 
 
80
$m = HTTP::Message->new([a => 1, b => 2], "abc");
 
81
ok($m->content("foo\n"), "abc");
 
82
ok($m->content, "foo\n");
 
83
 
 
84
$m->add_content("bar");
 
85
ok($m->content, "foo\nbar");
 
86
$m->add_content(\"\n");
 
87
ok($m->content, "foo\nbar\n");
 
88
 
 
89
ok(ref($m->content_ref), "SCALAR");
 
90
ok(${$m->content_ref}, "foo\nbar\n");
 
91
${$m->content_ref} =~ s/[ao]/i/g;
 
92
ok($m->content, "fii\nbir\n");
 
93
 
 
94
$m->clear;
 
95
ok($m->headers->header_field_names, 0);
 
96
ok($m->content, "");
 
97
 
 
98
ok($m->parts, undef);
 
99
$m->parts(HTTP::Message->new,
 
100
          HTTP::Message->new([a => 1], "foo"),
 
101
          HTTP::Message->new(undef, "bar\n"),
 
102
         );
 
103
ok($m->parts->as_string, "\n");
 
104
 
 
105
my $str = $m->as_string;
 
106
$str =~ s/\r/<CR>/g;
 
107
ok($str, <<EOT);
 
108
Content-Type: multipart/mixed; boundary=xYzZY
 
109
 
 
110
--xYzZY<CR>
 
111
<CR>
 
112
<CR>
 
113
--xYzZY<CR>
 
114
A: 1<CR>
 
115
<CR>
 
116
foo<CR>
 
117
--xYzZY<CR>
 
118
<CR>
 
119
bar
 
120
<CR>
 
121
--xYzZY--<CR>
 
122
EOT
 
123
 
 
124
$m2 = HTTP::Message->new;
 
125
$m2->parts($m);
 
126
 
 
127
$str = $m2->as_string;
 
128
$str =~ s/\r/<CR>/g;
 
129
ok($str =~ /boundary=(\S+)/);
 
130
 
 
131
 
 
132
ok($str, <<EOT);
 
133
Content-Type: multipart/mixed; boundary=$1
 
134
 
 
135
--$1<CR>
 
136
Content-Type: multipart/mixed; boundary=xYzZY<CR>
 
137
<CR>
 
138
--xYzZY<CR>
 
139
<CR>
 
140
<CR>
 
141
--xYzZY<CR>
 
142
A: 1<CR>
 
143
<CR>
 
144
foo<CR>
 
145
--xYzZY<CR>
 
146
<CR>
 
147
bar
 
148
<CR>
 
149
--xYzZY--<CR>
 
150
<CR>
 
151
--$1--<CR>
 
152
EOT
 
153
 
 
154
@parts = $m2->parts;
 
155
ok(@parts, 1);
 
156
 
 
157
@parts = $parts[0]->parts;
 
158
ok(@parts, 3);
 
159
ok($parts[1]->header("A"), 1);
 
160
 
 
161
$m2->parts([HTTP::Message->new]);
 
162
@parts = $m2->parts;
 
163
ok(@parts, 1);
 
164
 
 
165
$m2->parts([]);
 
166
@parts = $m2->parts;
 
167
ok(@parts, 0);
 
168
 
 
169
$m->clear;
 
170
$m2->clear;
 
171
 
 
172
$m = HTTP::Message->new([content_type => "message/http; boundary=aaa",
 
173
                        ],
 
174
                        <<EOT);
 
175
GET / HTTP/1.1
 
176
Host: www.example.com:8008
 
177
 
 
178
EOT
 
179
 
 
180
@parts = $m->parts;
 
181
ok(@parts, 1);
 
182
$m2 = $parts[0];
 
183
ok(ref($m2), "HTTP::Request");
 
184
ok($m2->method, "GET");
 
185
ok($m2->uri, "/");
 
186
ok($m2->protocol, "HTTP/1.1");
 
187
ok($m2->header("Host"), "www.example.com:8008");
 
188
ok($m2->content, "");
 
189
 
 
190
$m->content(<<EOT);
 
191
HTTP/1.0 200 OK
 
192
Content-Type: text/plain
 
193
 
 
194
Hello
 
195
EOT
 
196
 
 
197
$m2 = $m->parts;
 
198
ok(ref($m2), "HTTP::Response");
 
199
ok($m2->protocol, "HTTP/1.0");
 
200
ok($m2->code, "200");
 
201
ok($m2->message, "OK");
 
202
ok($m2->content_type, "text/plain");
 
203
ok($m2->content, "Hello\n");
 
204
 
 
205
eval { $m->parts(HTTP::Message->new, HTTP::Message->new) };
 
206
ok($@);
 
207
 
 
208
$m->add_part(HTTP::Message->new([a=>[1..3]], "a"));
 
209
$str = $m->as_string;
 
210
$str =~ s/\r/<CR>/g;
 
211
ok($str, <<EOT);
 
212
Content-Type: multipart/mixed; boundary=xYzZY
 
213
 
 
214
--xYzZY<CR>
 
215
Content-Type: message/http; boundary=aaa<CR>
 
216
<CR>
 
217
HTTP/1.0 200 OK
 
218
Content-Type: text/plain
 
219
 
 
220
Hello
 
221
<CR>
 
222
--xYzZY<CR>
 
223
A: 1<CR>
 
224
A: 2<CR>
 
225
A: 3<CR>
 
226
<CR>
 
227
a<CR>
 
228
--xYzZY--<CR>
 
229
EOT
 
230
 
 
231
$m->add_part(HTTP::Message->new([b=>[1..3]], "b"));
 
232
 
 
233
$str = $m->as_string;
 
234
$str =~ s/\r/<CR>/g;
 
235
ok($str, <<EOT);
 
236
Content-Type: multipart/mixed; boundary=xYzZY
 
237
 
 
238
--xYzZY<CR>
 
239
Content-Type: message/http; boundary=aaa<CR>
 
240
<CR>
 
241
HTTP/1.0 200 OK
 
242
Content-Type: text/plain
 
243
 
 
244
Hello
 
245
<CR>
 
246
--xYzZY<CR>
 
247
A: 1<CR>
 
248
A: 2<CR>
 
249
A: 3<CR>
 
250
<CR>
 
251
a<CR>
 
252
--xYzZY<CR>
 
253
B: 1<CR>
 
254
B: 2<CR>
 
255
B: 3<CR>
 
256
<CR>
 
257
b<CR>
 
258
--xYzZY--<CR>
 
259
EOT
 
260
 
 
261
$m = HTTP::Message->new;
 
262
$m->content_ref(\my $foo);
 
263
ok($m->content_ref, \$foo);
 
264
$foo = "foo";
 
265
ok($m->content, "foo");
 
266
$m->add_content("bar");
 
267
ok($foo, "foobar");
 
268
ok($m->as_string, "\nfoobar\n");
 
269
$m->content_type("message/foo");
 
270
$m->parts(HTTP::Message->new(["h", "v"], "C"));
 
271
ok($foo, "H: v\r\n\r\nC");
 
272
$foo =~ s/C/c/;
 
273
$m2 = $m->parts;
 
274
ok($m2->content, "c");
 
275
 
 
276
$m = HTTP::Message->new;
 
277
$foo = [];
 
278
$m->content($foo);
 
279
ok($m->content, $foo);
 
280
ok(${$m->content_ref}, $foo);
 
281
ok(${$m->content_ref([])}, $foo);
 
282
ok($m->content_ref != $foo);
 
283
eval {$m->add_content("x")};
 
284
ok($@ && $@ =~ /^Can't append to ARRAY content/);
 
285
 
 
286
$foo = sub { "foo" };
 
287
$m->content($foo);
 
288
ok($m->content, $foo);
 
289
ok(${$m->content_ref}, $foo);
 
290
 
 
291
$m->content_ref($foo);
 
292
ok($m->content, $foo);
 
293
ok($m->content_ref, $foo);
 
294
 
 
295
eval {$m->content_ref("foo")};
 
296
ok($@ && $@ =~ /^Setting content_ref to a non-ref/);
 
297
 
 
298
$m->content_ref(\"foo");
 
299
eval {$m->content("bar")};
 
300
ok($@ && $@ =~ /^Modification of a read-only value/);
 
301
 
 
302
$foo = "foo";
 
303
$m->content_ref(\$foo);
 
304
ok($m->content("bar"), "foo");
 
305
ok($foo, "bar");
 
306
ok($m->content, "bar");
 
307
ok($m->content_ref, \$foo);
 
308
 
 
309
$m = HTTP::Message->new;
 
310
$m->content("fo=6F");
 
311
ok($m->decoded_content, "fo=6F");
 
312
$m->header("Content-Encoding", "quoted-printable");
 
313
ok($m->decoded_content, "foo");
 
314
 
 
315
$m = HTTP::Message->new;
 
316
$m->header("Content-Encoding", "gzip, base64");
 
317
$m->content_type("text/plain; charset=UTF-8");
 
318
$m->content("H4sICFWAq0ECA3h4eAB7v3u/R6ZCSUZqUarCoxm7uAAZKHXiEAAAAA==\n");
 
319
 
 
320
$@ = "";
 
321
skip($] < 5.008 ? "No Encode module" : "",
 
322
     sub { eval { $m->decoded_content } }, "\x{FEFF}Hi there \x{263A}\n");
 
323
ok($@ || "", "");
 
324
ok($m->content, "H4sICFWAq0ECA3h4eAB7v3u/R6ZCSUZqUarCoxm7uAAZKHXiEAAAAA==\n");
 
325
 
 
326
my $tmp = MIME::Base64::decode($m->content);
 
327
$m->content($tmp);
 
328
$m->header("Content-Encoding", "gzip");
 
329
$@ = "";
 
330
skip($] < 5.008 ? "No Encode module" : "",
 
331
     sub { eval { $m->decoded_content } }, "\x{FEFF}Hi there \x{263A}\n");
 
332
ok($@ || "", "");
 
333
ok($m->content, $tmp);
 
334
 
 
335
$m->header("Content-Encoding", "foobar");
 
336
ok($m->decoded_content, undef);
 
337
ok($@ =~ /^Don't know how to decode Content-Encoding 'foobar'/);
 
338
 
 
339
my $err = 0;
 
340
eval {
 
341
    $m->decoded_content(raise_error => 1);
 
342
    $err++;
 
343
};
 
344
ok($@ =~ /Don't know how to decode Content-Encoding 'foobar'/);
 
345
ok($err, 0);