line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package LWP::MediaTypes; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
require Exporter; |
4
|
|
|
|
|
|
|
@ISA = qw(Exporter); |
5
|
|
|
|
|
|
|
@EXPORT = qw(guess_media_type media_suffix); |
6
|
|
|
|
|
|
|
@EXPORT_OK = qw(add_type add_encoding read_media_types); |
7
|
|
|
|
|
|
|
our $VERSION = '6.04'; |
8
|
|
|
|
|
|
|
|
9
|
1
|
|
|
1
|
|
72661
|
use strict; |
|
1
|
|
|
|
|
13
|
|
|
1
|
|
|
|
|
32
|
|
10
|
1
|
|
|
1
|
|
6
|
use Scalar::Util qw(blessed); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
44
|
|
11
|
1
|
|
|
1
|
|
5
|
use Carp qw(croak); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
1122
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
# note: These hashes will also be filled with the entries found in |
14
|
|
|
|
|
|
|
# the 'media.types' file. |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
my %suffixType = ( |
17
|
|
|
|
|
|
|
'txt' => 'text/plain', |
18
|
|
|
|
|
|
|
'html' => 'text/html', |
19
|
|
|
|
|
|
|
'gif' => 'image/gif', |
20
|
|
|
|
|
|
|
'jpg' => 'image/jpeg', |
21
|
|
|
|
|
|
|
'xml' => 'text/xml', |
22
|
|
|
|
|
|
|
); |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
my %suffixExt = ( |
25
|
|
|
|
|
|
|
'text/plain' => 'txt', |
26
|
|
|
|
|
|
|
'text/html' => 'html', |
27
|
|
|
|
|
|
|
'image/gif' => 'gif', |
28
|
|
|
|
|
|
|
'image/jpeg' => 'jpg', |
29
|
|
|
|
|
|
|
'text/xml' => 'xml', |
30
|
|
|
|
|
|
|
); |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
#XXX: there should be some way to define this in the media.types files. |
33
|
|
|
|
|
|
|
my %suffixEncoding = ( |
34
|
|
|
|
|
|
|
'Z' => 'compress', |
35
|
|
|
|
|
|
|
'gz' => 'gzip', |
36
|
|
|
|
|
|
|
'hqx' => 'x-hqx', |
37
|
|
|
|
|
|
|
'uu' => 'x-uuencode', |
38
|
|
|
|
|
|
|
'z' => 'x-pack', |
39
|
|
|
|
|
|
|
'bz2' => 'x-bzip2', |
40
|
|
|
|
|
|
|
); |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
read_media_types(); |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
sub guess_media_type |
47
|
|
|
|
|
|
|
{ |
48
|
29
|
|
|
29
|
1
|
20746
|
my($file, $header) = @_; |
49
|
29
|
50
|
|
|
|
68
|
return undef unless defined $file; |
50
|
|
|
|
|
|
|
|
51
|
29
|
|
|
|
|
41
|
my $fullname; |
52
|
29
|
100
|
|
|
|
72
|
if (ref $file) { |
53
|
9
|
100
|
|
|
|
252
|
croak("Unable to determine filetype on unblessed refs") unless blessed($file); |
54
|
8
|
100
|
|
|
|
62
|
if ($file->can('path')) { |
|
|
100
|
|
|
|
|
|
55
|
4
|
|
|
|
|
12
|
$file = $file->path; |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
elsif ($file->can('filename')) { |
58
|
2
|
|
|
|
|
6
|
$fullname = $file->filename; |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
else { |
61
|
2
|
|
|
|
|
34
|
$fullname = "" . $file; |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
else { |
65
|
20
|
|
|
|
|
27
|
$fullname = $file; # enable peek at actual file |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
28
|
|
|
|
|
95
|
my @encoding = (); |
69
|
28
|
|
|
|
|
40
|
my $ct = undef; |
70
|
28
|
|
|
|
|
50
|
for (file_exts($file)) { |
71
|
|
|
|
|
|
|
# first check this dot part as encoding spec |
72
|
28
|
100
|
|
|
|
71
|
if (exists $suffixEncoding{$_}) { |
73
|
10
|
|
|
|
|
25
|
unshift(@encoding, $suffixEncoding{$_}); |
74
|
10
|
|
|
|
|
15
|
next; |
75
|
|
|
|
|
|
|
} |
76
|
18
|
100
|
|
|
|
42
|
if (exists $suffixEncoding{lc $_}) { |
77
|
2
|
|
|
|
|
7
|
unshift(@encoding, $suffixEncoding{lc $_}); |
78
|
2
|
|
|
|
|
4
|
next; |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
# check content-type |
82
|
16
|
100
|
|
|
|
40
|
if (exists $suffixType{$_}) { |
83
|
14
|
|
|
|
|
25
|
$ct = $suffixType{$_}; |
84
|
14
|
|
|
|
|
19
|
last; |
85
|
|
|
|
|
|
|
} |
86
|
2
|
50
|
|
|
|
7
|
if (exists $suffixType{lc $_}) { |
87
|
0
|
|
|
|
|
0
|
$ct = $suffixType{lc $_}; |
88
|
0
|
|
|
|
|
0
|
last; |
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
# don't know nothing about this dot part, bail out |
92
|
2
|
|
|
|
|
4
|
last; |
93
|
|
|
|
|
|
|
} |
94
|
28
|
100
|
|
|
|
65
|
unless (defined $ct) { |
95
|
|
|
|
|
|
|
# Take a look at the file |
96
|
14
|
100
|
|
|
|
30
|
if (defined $fullname) { |
97
|
12
|
100
|
|
|
|
482
|
$ct = (-T $fullname) ? "text/plain" : "application/octet-stream"; |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
else { |
100
|
2
|
|
|
|
|
3
|
$ct = "application/octet-stream"; |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
|
104
|
28
|
100
|
|
|
|
83
|
if ($header) { |
105
|
1
|
|
|
|
|
21
|
$header->header('Content-Type' => $ct); |
106
|
1
|
50
|
|
|
|
19
|
$header->header('Content-Encoding' => \@encoding) if @encoding; |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
28
|
100
|
|
|
|
111
|
wantarray ? ($ct, @encoding) : $ct; |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
sub media_suffix { |
114
|
3
|
50
|
66
|
3
|
1
|
1959
|
if (!wantarray && @_ == 1 && $_[0] !~ /\*/) { |
|
|
|
66
|
|
|
|
|
115
|
1
|
|
|
|
|
7
|
return $suffixExt{lc $_[0]}; |
116
|
|
|
|
|
|
|
} |
117
|
2
|
|
|
|
|
6
|
my(@type) = @_; |
118
|
2
|
|
|
|
|
4
|
my(@suffix, $ext, $type); |
119
|
2
|
|
|
|
|
6
|
foreach (@type) { |
120
|
2
|
50
|
|
|
|
12
|
if (s/\*/.*/) { |
121
|
2
|
|
|
|
|
11
|
while(($ext,$type) = each(%suffixType)) { |
122
|
1766
|
100
|
|
|
|
6487
|
push(@suffix, $ext) if $type =~ /^$_$/i; |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
else { |
126
|
0
|
|
|
|
|
0
|
my $ltype = lc $_; |
127
|
0
|
|
|
|
|
0
|
while(($ext,$type) = each(%suffixType)) { |
128
|
0
|
0
|
|
|
|
0
|
push(@suffix, $ext) if lc $type eq $ltype; |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
} |
132
|
2
|
50
|
|
|
|
27
|
wantarray ? @suffix : $suffix[0]; |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
sub file_exts |
137
|
|
|
|
|
|
|
{ |
138
|
28
|
|
|
28
|
0
|
135
|
require File::Basename; |
139
|
28
|
|
|
|
|
826
|
my @parts = reverse split(/\./, File::Basename::basename($_[0])); |
140
|
28
|
|
|
|
|
122
|
pop(@parts); # never consider first part |
141
|
28
|
|
|
|
|
70
|
@parts; |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
sub add_type |
146
|
|
|
|
|
|
|
{ |
147
|
2065
|
|
|
2065
|
1
|
3644
|
my($type, @exts) = @_; |
148
|
2065
|
|
|
|
|
2896
|
for my $ext (@exts) { |
149
|
2651
|
|
|
|
|
3446
|
$ext =~ s/^\.//; |
150
|
2651
|
|
|
|
|
4999
|
$suffixType{$ext} = $type; |
151
|
|
|
|
|
|
|
} |
152
|
2065
|
50
|
|
|
|
7881
|
$suffixExt{lc $type} = $exts[0] if @exts; |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
sub add_encoding |
157
|
|
|
|
|
|
|
{ |
158
|
2
|
|
|
2
|
1
|
6
|
my($type, @exts) = @_; |
159
|
2
|
|
|
|
|
5
|
for my $ext (@exts) { |
160
|
2
|
|
|
|
|
4
|
$ext =~ s/^\.//; |
161
|
2
|
|
|
|
|
6
|
$suffixEncoding{$ext} = $type; |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
sub read_media_types |
167
|
|
|
|
|
|
|
{ |
168
|
1
|
|
|
1
|
1
|
3
|
my(@files) = @_; |
169
|
|
|
|
|
|
|
|
170
|
1
|
|
|
|
|
7
|
local($/, $_) = ("\n", undef); # ensure correct $INPUT_RECORD_SEPARATOR |
171
|
|
|
|
|
|
|
|
172
|
1
|
|
|
|
|
2
|
my @priv_files = (); |
173
|
|
|
|
|
|
|
push(@priv_files, "$ENV{HOME}/.media.types", "$ENV{HOME}/.mime.types") |
174
|
1
|
50
|
|
|
|
8
|
if defined $ENV{HOME}; # Some doesn't have a home (for instance Win32) |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
# Try to locate "media.types" file, and initialize %suffixType from it |
177
|
1
|
|
|
|
|
2
|
my $typefile; |
178
|
1
|
50
|
|
|
|
4
|
unless (@files) { |
179
|
1
|
|
|
|
|
2
|
@files = map {"$_/LWP/media.types"} @INC; |
|
11
|
|
|
|
|
26
|
|
180
|
1
|
|
|
|
|
3
|
push @files, @priv_files; |
181
|
|
|
|
|
|
|
} |
182
|
1
|
|
|
|
|
2
|
for $typefile (@files) { |
183
|
13
|
|
|
|
|
41
|
local(*TYPE); |
184
|
13
|
100
|
|
|
|
370
|
open(TYPE, $typefile) || next; |
185
|
3
|
|
|
|
|
71
|
while () { |
186
|
4437
|
100
|
|
|
|
12805
|
next if /^\s*#/; # comment line |
187
|
2064
|
50
|
|
|
|
4099
|
next if /^\s*$/; # blank line |
188
|
2064
|
|
|
|
|
2860
|
s/#.*//; # remove end-of-line comments |
189
|
2064
|
|
|
|
|
5156
|
my($type, @exts) = split(' ', $_); |
190
|
2064
|
|
|
|
|
3565
|
add_type($type, @exts); |
191
|
|
|
|
|
|
|
} |
192
|
3
|
|
|
|
|
49
|
close(TYPE); |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
1; |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
__END__ |