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
|
use LWP::MediaTypes;
require URI::URL;
$url1 = new URI::URL 'http://www/foo/test.gif?search+x#frag';
$url2 = new URI::URL 'http:test';
$file = "/etc/passwd";
-r $file or $file = "./README";
@tests =
(
["/this.dir/file.html" => "text/html",],
["test.gif.htm" => "text/html",],
["test.txt.gz" => "text/plain", "gzip"],
["gif.foo" => "application/octet-stream",],
["lwp-0.03.tar.Z" => "application/x-tar", "compress"],
[$file => "text/plain",],
["/random/file" => "application/octet-stream",],
["/dev/null" => "text/plain",],
[$url1 => "image/gif",],
[$url2 => "application/octet-stream",],
["x.ppm.Z.UU" => "image/x-portable-pixmap","compress","x-uuencode",],
);
$notests = @tests + 3;
print "1..$notests\n";
if (-f "$ENV{HOME}/.mime.types") {
warn "
The MediaTypes test might fail because you have a private ~/.mime.types file
If you get a failed test, try to move it away while testing.
";
}
$testno = 1;
for (@tests) {
($file, $expectedtype, @expectedEnc) = @$_;
$type1 = guess_media_type($file);
($type, @enc) = guess_media_type($file);
if ($type1 ne $type) {
print "guess_media_type does not return same content-type in scalar and array conext.\n";
next;
}
$type = "undef" unless defined $type;
if ($type eq $expectedtype and "@enc" eq "@expectedEnc") {
print "ok $testno\n";
} else {
print "expected '$expectedtype' for '$file', got '$type'\n";
print "encoding: expected: '@expectedEnc', got '@enc'\n"
if @expectedEnc || @enc;
print "nok ok $testno\n";
}
$testno++;
}
@imgSuffix = media_suffix('image/*');
print "Image suffixes: @imgSuffix\n";
print "\n";
require HTTP::Response;
$r = new HTTP::Response 200, "Document follows";
$r->title("file.tar.gz.uu");
guess_media_type($r->title, $r);
print $r->as_string;
print "not " unless $r->content_type eq "application/x-tar";
print "ok $testno\n"; $testno++;
@enc = $r->header("Content-Encoding");
print "not " unless "@enc" eq "gzip x-uuencode";
print "ok $testno\n"; $testno++;
#
use LWP::MediaTypes qw(add_type add_encoding);
add_type("x-world/x-vrml", qw(wrl vrml));
add_encoding("x-gzip" => "gz");
add_encoding(rot13 => "r13");
@x = guess_media_type("foo.vrml.r13.gz");
#print "@x\n";
print "not " unless "@x" eq "x-world/x-vrml rot13 x-gzip";
print "ok $testno\n"; $testno++;
#print LWP::MediaTypes::_dump();
|
