line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Data::FormValidator::Constraints::Upload; |
2
|
3
|
|
|
3
|
|
148463
|
use Exporter 'import'; |
|
3
|
|
|
|
|
9
|
|
|
3
|
|
|
|
|
101
|
|
3
|
3
|
|
|
3
|
|
14
|
use strict; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
1261
|
|
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
# Items to export into callers namespace by default. Note: do not export |
6
|
|
|
|
|
|
|
# names by default without a very good reason. Use EXPORT_OK instead. |
7
|
|
|
|
|
|
|
# Do not simply export all your public functions/methods/constants. |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
# This allows declaration use Data::FormValidator::Constraints::Upload ':all'; |
10
|
|
|
|
|
|
|
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK |
11
|
|
|
|
|
|
|
# will save memory. |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
our @EXPORT = qw( |
14
|
|
|
|
|
|
|
valid_file_format |
15
|
|
|
|
|
|
|
valid_image_max_dimensions |
16
|
|
|
|
|
|
|
valid_file_max_bytes |
17
|
|
|
|
|
|
|
valid_image_min_dimensions |
18
|
|
|
|
|
|
|
); |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
our @EXPORT_OK = qw( |
21
|
|
|
|
|
|
|
file_format |
22
|
|
|
|
|
|
|
image_max_dimensions |
23
|
|
|
|
|
|
|
file_max_bytes |
24
|
|
|
|
|
|
|
image_min_dimensions |
25
|
|
|
|
|
|
|
); |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
our $VERSION = 4.88; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
sub file_format { |
30
|
5
|
|
|
5
|
1
|
11840
|
my %params = @_; |
31
|
|
|
|
|
|
|
return sub { |
32
|
5
|
|
|
5
|
|
8
|
my $self = shift; |
33
|
5
|
|
|
|
|
16
|
$self->set_current_constraint_name('file_format'); |
34
|
5
|
|
|
|
|
14
|
valid_file_format($self,\%params); |
35
|
|
|
|
|
|
|
} |
36
|
5
|
|
|
|
|
27
|
} |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
sub image_max_dimensions { |
39
|
5
|
|
50
|
5
|
1
|
692
|
my $w = shift || die 'image_max_dimensions: missing maximum width value'; |
40
|
5
|
|
50
|
|
|
13
|
my $h = shift || die 'image_max_dimensions: missing maximum height value'; |
41
|
|
|
|
|
|
|
return sub { |
42
|
6
|
|
|
6
|
|
10
|
my $self = shift; |
43
|
6
|
|
|
|
|
17
|
$self->set_current_constraint_name('image_max_dimensions'); |
44
|
6
|
|
|
|
|
17
|
valid_image_max_dimensions($self,\$w,\$h); |
45
|
|
|
|
|
|
|
} |
46
|
5
|
|
|
|
|
29
|
} |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub file_max_bytes { |
49
|
2
|
|
|
2
|
1
|
4
|
my ($max_bytes) = @_; |
50
|
|
|
|
|
|
|
return sub { |
51
|
2
|
|
|
2
|
|
4
|
my $self = shift; |
52
|
2
|
|
|
|
|
7
|
$self->set_current_constraint_name('file_max_bytes'); |
53
|
2
|
|
|
|
|
7
|
valid_file_max_bytes($self,\$max_bytes); |
54
|
|
|
|
|
|
|
} |
55
|
2
|
|
|
|
|
17
|
} |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
sub image_min_dimensions { |
58
|
2
|
|
50
|
2
|
1
|
4
|
my $w = shift || die 'image_min_dimensions: missing minimum width value'; |
59
|
2
|
|
50
|
|
|
6
|
my $h = shift || die 'image_min_dimensions: missing minimum height value'; |
60
|
|
|
|
|
|
|
return sub { |
61
|
2
|
|
|
2
|
|
4
|
my $self = shift; |
62
|
2
|
|
|
|
|
6
|
$self->set_current_constraint_name('image_min_dimensions'); |
63
|
2
|
|
|
|
|
6
|
valid_image_min_dimensions($self,\$w,\$h); |
64
|
|
|
|
|
|
|
} |
65
|
2
|
|
|
|
|
10
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
sub valid_file_format { |
68
|
8
|
|
|
8
|
0
|
13
|
my $self = shift; |
69
|
8
|
50
|
|
|
|
34
|
$self->isa('Data::FormValidator::Results') || |
70
|
|
|
|
|
|
|
die "file_format: first argument is not a Data::FormValidator::Results object. "; |
71
|
8
|
|
100
|
|
|
25
|
my $params = shift || {}; |
72
|
|
|
|
|
|
|
# if (ref $params ne 'HASH' ) { |
73
|
|
|
|
|
|
|
# die "format: hash reference expected. Make sure you have |
74
|
|
|
|
|
|
|
# included 'params => []' in your constraint definition, even if there |
75
|
|
|
|
|
|
|
# are no additional arguments"; |
76
|
|
|
|
|
|
|
# } |
77
|
8
|
|
|
|
|
26
|
my $q = $self->get_filtered_data; |
78
|
|
|
|
|
|
|
|
79
|
8
|
|
|
|
|
22
|
my $field = $self->get_current_constraint_field; |
80
|
8
|
|
|
|
|
20
|
my $fh = _get_upload_fh($self); |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
## load filehandle |
83
|
8
|
50
|
|
|
|
501
|
if (!$fh) { |
84
|
0
|
0
|
|
|
|
0
|
warn "$0: can't get filehandle for field named $field" and return undef; |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
## load file magic stuff |
88
|
8
|
|
|
|
|
939
|
require File::MMagic; |
89
|
8
|
|
|
|
|
10554
|
my $mm = File::MMagic->new; |
90
|
8
|
|
|
|
|
3207
|
my $fm_mt; |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
## only use filehandle bits for magic data |
93
|
8
|
|
33
|
|
|
26
|
$fm_mt = $mm->checktype_filehandle($fh) || |
94
|
|
|
|
|
|
|
(warn "$0: can't get filehandle for field named $field" and return undef); |
95
|
|
|
|
|
|
|
# Work around a bug in File::MMagic (RT#12074) |
96
|
8
|
|
|
|
|
121811
|
seek($fh,0,0); |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
# File::MMagic returns 'application/octet-stream" as a punt |
99
|
|
|
|
|
|
|
# for "I don't know, here's a generic binary MIME type. |
100
|
|
|
|
|
|
|
# In some cases that is has indicated a bug in File::MMagic, |
101
|
|
|
|
|
|
|
# but it's a generally worthless response for identifying the file type. |
102
|
|
|
|
|
|
|
# so, we throw away the response in that case. The uploaded MIME type |
103
|
|
|
|
|
|
|
# will be used instead later, if present |
104
|
8
|
50
|
|
|
|
29
|
$fm_mt = undef if ($fm_mt eq 'application/octet-stream'); |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
## fetch mime type universally (or close) |
108
|
8
|
|
|
|
|
29
|
my $uploaded_mt = _get_upload_mime_type($self); |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
# try the File::MMagic, then the uploaded field, then return undef we find neither |
111
|
8
|
50
|
33
|
|
|
196
|
my $mt = ($fm_mt || $uploaded_mt) or return undef; |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
# figure out an extension |
114
|
3
|
|
|
3
|
|
752
|
use MIME::Types; |
|
3
|
|
|
|
|
11978
|
|
|
3
|
|
|
|
|
2740
|
|
115
|
8
|
|
|
|
|
61
|
my $mimetypes = MIME::Types->new; |
116
|
8
|
|
|
|
|
83594
|
my MIME::Type $t = $mimetypes->type($mt); |
117
|
8
|
50
|
|
|
|
499
|
my @mt_exts = $t ? $t->extensions : (); |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
## setup filename to retrieve extension |
120
|
8
|
|
|
|
|
111
|
my $fn = $self->get_input_data->param($field); |
121
|
8
|
|
|
|
|
190
|
my ($uploaded_ext) = ($fn =~ m/\.([\w\d]*)?$/); |
122
|
8
|
|
|
|
|
131
|
my $ext; |
123
|
|
|
|
|
|
|
|
124
|
8
|
50
|
|
|
|
25
|
if (scalar @mt_exts) { |
125
|
|
|
|
|
|
|
# If the upload extension is one recognized by MIME::Type, use it. |
126
|
8
|
100
|
|
|
|
20
|
if (grep {/^$uploaded_ext$/} @mt_exts) { |
|
48
|
|
|
|
|
224
|
|
127
|
6
|
|
|
|
|
68
|
$ext = $uploaded_ext; |
128
|
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
|
# otherwise, use one from MIME::Type, just to be safe |
130
|
|
|
|
|
|
|
else { |
131
|
2
|
|
|
|
|
6
|
$ext = $mt_exts[0]; |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
else { |
135
|
|
|
|
|
|
|
# If is a provided extension but no MIME::Type extension, use that. |
136
|
|
|
|
|
|
|
# It's possible that there no extension uploaded or found) |
137
|
0
|
|
|
|
|
0
|
$ext = $uploaded_ext; |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
# Add the mime_type and extension to the valid data set |
141
|
8
|
|
50
|
|
|
77
|
my $info = $self->meta($field) || {}; |
142
|
8
|
|
|
|
|
51
|
$info = { %$info, mime_type => $mt, extension => ".$ext" }; |
143
|
8
|
|
|
|
|
30
|
$self->meta($field,$info); |
144
|
|
|
|
|
|
|
|
145
|
8
|
|
|
|
|
24
|
return _is_allowed_type($mt, $params); |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
## Returns true if the passed-in mime-type matches our allowed types |
149
|
|
|
|
|
|
|
sub _is_allowed_type { |
150
|
12
|
|
|
12
|
|
431
|
my $mt = shift; |
151
|
12
|
|
|
|
|
21
|
my $params = shift; |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
# XXX perhaps this should be in a global variable so it's easier |
154
|
|
|
|
|
|
|
# for other apps to change the defaults; |
155
|
12
|
|
100
|
|
|
75
|
$params->{mime_types} ||= [qw!image/jpeg image/pjpeg image/gif image/png!]; |
156
|
12
|
|
|
|
|
21
|
my %allowed_types = map { $_ => 1 } @{ $params->{mime_types} }; |
|
42
|
|
|
|
|
99
|
|
|
12
|
|
|
|
|
28
|
|
157
|
|
|
|
|
|
|
|
158
|
12
|
|
|
|
|
549
|
return $allowed_types{lc $mt}; |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
sub valid_image_max_dimensions { |
163
|
10
|
|
|
10
|
0
|
17
|
my $self = shift; |
164
|
10
|
50
|
|
|
|
36
|
$self->isa('Data::FormValidator::Results') || |
165
|
|
|
|
|
|
|
die "image_max_dimensions: first argument is not a Data::FormValidator::Results object. "; |
166
|
10
|
|
50
|
|
|
24
|
my $max_width_ref = shift || die 'image_max_dimensions: missing maximum width value'; |
167
|
10
|
|
50
|
|
|
20
|
my $max_height_ref = shift || die 'image_max_dimensions: missing maximum height value'; |
168
|
10
|
|
|
|
|
15
|
my $max_width = $$max_width_ref; |
169
|
10
|
|
|
|
|
13
|
my $max_height = $$max_height_ref; |
170
|
10
|
50
|
|
|
|
22
|
($max_width > 0) || die 'image_max_dimensions: maximum width must be > 0'; |
171
|
10
|
50
|
|
|
|
20
|
($max_height > 0) || die 'image_max_dimensions: maximum height must be > 0'; |
172
|
|
|
|
|
|
|
|
173
|
10
|
|
|
|
|
22
|
my $q = $self->get_filtered_data; |
174
|
10
|
|
|
|
|
22
|
my $field = $self->get_current_constraint_field; |
175
|
10
|
|
|
|
|
24
|
my ($width,$height) = _get_img_size($self); |
176
|
|
|
|
|
|
|
|
177
|
10
|
50
|
|
|
|
22
|
unless ($width) { |
178
|
0
|
|
|
|
|
0
|
warn "$0: imgsize test failed"; |
179
|
0
|
|
|
|
|
0
|
return undef; |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
# Add the dimensions to the valid hash |
183
|
10
|
|
50
|
|
|
42
|
my $info = $self->meta($field) || {}; |
184
|
10
|
|
|
|
|
44
|
$info = { %$info, width => $width, height => $height }; |
185
|
10
|
|
|
|
|
30
|
$self->meta($field,$info); |
186
|
|
|
|
|
|
|
|
187
|
10
|
|
66
|
|
|
45
|
return (($width <= $$max_width_ref) and ($height <= $$max_height_ref)); |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
sub valid_file_max_bytes { |
191
|
4
|
|
|
4
|
0
|
7
|
my $self = shift; |
192
|
|
|
|
|
|
|
|
193
|
4
|
50
|
|
|
|
20
|
$self->isa('Data::FormValidator::Results') || |
194
|
|
|
|
|
|
|
die "first argument is not a Data::FormValidator::Results object."; |
195
|
|
|
|
|
|
|
|
196
|
4
|
|
|
|
|
8
|
my $max_bytes_ref = shift; |
197
|
4
|
|
|
|
|
6
|
my $max_bytes; |
198
|
|
|
|
|
|
|
|
199
|
4
|
100
|
100
|
|
|
19
|
if ((ref $max_bytes_ref) and defined $$max_bytes_ref) { |
200
|
2
|
|
|
|
|
5
|
$max_bytes = $$max_bytes_ref; |
201
|
|
|
|
|
|
|
} |
202
|
|
|
|
|
|
|
else { |
203
|
2
|
|
|
|
|
6
|
$max_bytes = 1024*1024; # default to 1 Meg |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
4
|
|
|
|
|
12
|
my $q = $self->get_filtered_data; |
207
|
|
|
|
|
|
|
|
208
|
4
|
|
|
|
|
12
|
my $field = $self->get_current_constraint_field; |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
## retrieve upload fh for field |
211
|
4
|
|
|
|
|
14
|
my $fh = _get_upload_fh($self); |
212
|
4
|
50
|
0
|
|
|
315
|
if (!$fh) { warn "Failed to load filehandle for $field" && return undef; } |
|
0
|
|
|
|
|
0
|
|
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
## retrieve size |
215
|
4
|
|
|
|
|
26
|
my $file_size = (stat ($fh))[7]; |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
# Add the size to the valid hash |
218
|
4
|
|
100
|
|
|
15
|
my $info = $self->meta($field) || {}; |
219
|
4
|
|
|
|
|
27
|
$info = { %$info, bytes => $file_size }; |
220
|
4
|
|
|
|
|
14
|
$self->meta($field,$info); |
221
|
|
|
|
|
|
|
|
222
|
4
|
|
|
|
|
20
|
return ($file_size <= $max_bytes); |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
sub valid_image_min_dimensions { |
226
|
4
|
|
|
4
|
0
|
7
|
my $self = shift; |
227
|
4
|
50
|
|
|
|
21
|
$self->isa('Data::FormValidator::Results') || |
228
|
|
|
|
|
|
|
die "image_min_dimensions: first argument is not a Data::FormValidator::Results object. "; |
229
|
4
|
|
50
|
|
|
8
|
my $min_width_ref = shift || |
230
|
|
|
|
|
|
|
die 'image_min_dimensions: missing minimum width value'; |
231
|
4
|
|
50
|
|
|
10
|
my $min_height_ref = shift || |
232
|
|
|
|
|
|
|
die 'image_min_dimensions: missing minimum height value'; |
233
|
4
|
|
|
|
|
6
|
my $min_width = $$min_width_ref; |
234
|
4
|
|
|
|
|
7
|
my $min_height = $$min_height_ref; |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
## do these matter? |
237
|
4
|
50
|
|
|
|
8
|
($min_width > 0) || die 'image_min_dimensions: minimum width must be > 0'; |
238
|
4
|
50
|
|
|
|
9
|
($min_height > 0) || die 'image_min_dimensions: minimum height must be > 0'; |
239
|
|
|
|
|
|
|
|
240
|
4
|
|
|
|
|
7
|
my $q = $self->get_filtered_data; |
241
|
4
|
|
|
|
|
7
|
my $field = $self->get_current_constraint_field; |
242
|
4
|
|
|
|
|
9
|
my ($width, $height) = _get_img_size($self); |
243
|
|
|
|
|
|
|
|
244
|
4
|
50
|
|
|
|
12
|
unless ($width) { |
245
|
0
|
|
|
|
|
0
|
warn "image failed processing"; |
246
|
0
|
|
|
|
|
0
|
return undef; |
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
# Add the dimensions to the valid hash |
250
|
4
|
|
100
|
|
|
12
|
my $info = $self->meta($field) || {}; |
251
|
4
|
|
|
|
|
15
|
$info = { %$info, width => $width, height => $height }; |
252
|
4
|
|
|
|
|
12
|
$self->meta($field,$info); |
253
|
|
|
|
|
|
|
|
254
|
4
|
|
66
|
|
|
19
|
return (($width >= $min_width) and ($height >= $min_height)); |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
sub _get_img_size |
258
|
|
|
|
|
|
|
{ |
259
|
14
|
|
|
14
|
|
18
|
my $self = shift; |
260
|
14
|
|
|
|
|
27
|
my $q = $self->get_filtered_data; |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
## setup caller to make can errors more useful |
263
|
14
|
|
|
|
|
56
|
my $caller = (caller(1))[3]; |
264
|
14
|
|
|
|
|
29
|
my $pkg = __PACKAGE__ . "::"; |
265
|
14
|
|
|
|
|
80
|
$caller =~ s/$pkg//g; |
266
|
|
|
|
|
|
|
|
267
|
14
|
|
|
|
|
31
|
my $field = $self->get_current_constraint_field; |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
## retrieve filehandle from query object. |
270
|
14
|
|
|
|
|
30
|
my $fh = _get_upload_fh($self); |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
## check error |
273
|
14
|
50
|
|
|
|
807
|
if (not $fh) { |
274
|
0
|
|
|
|
|
0
|
warn "Unable to load filehandle"; |
275
|
0
|
|
|
|
|
0
|
return undef; |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
|
278
|
14
|
|
|
|
|
883
|
require Image::Size; |
279
|
14
|
|
|
|
|
6902
|
import Image::Size; |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
## check size |
282
|
14
|
|
|
|
|
43
|
my ($width, $height, $err) = imgsize($fh); |
283
|
|
|
|
|
|
|
|
284
|
14
|
50
|
|
|
|
1243
|
unless ($width) { |
285
|
0
|
|
|
|
|
0
|
warn "$caller: imgsize test failed: $err"; |
286
|
0
|
|
|
|
|
0
|
return undef; |
287
|
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
|
|
289
|
14
|
|
|
|
|
67
|
return ($width, $height); |
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
## fetch filehandle for use with various file type checking |
293
|
|
|
|
|
|
|
## call it with (_get_upload_fh($self)) since kind of mock object |
294
|
|
|
|
|
|
|
sub _get_upload_fh |
295
|
|
|
|
|
|
|
{ |
296
|
26
|
|
|
26
|
|
36
|
my $self = shift; |
297
|
26
|
|
|
|
|
52
|
my $q = $self->get_filtered_data; |
298
|
26
|
|
|
|
|
47
|
my $field = $self->get_current_constraint_field; |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
# convert the FH for the filtered data into a -seekable- handle; |
301
|
|
|
|
|
|
|
# depending on whether we're using CGI::Simple, CGI, or Apache::Request |
302
|
|
|
|
|
|
|
# we might not have something -seekable-. |
303
|
3
|
|
|
3
|
|
1005
|
use IO::File; |
|
3
|
|
|
|
|
20117
|
|
|
3
|
|
|
|
|
917
|
|
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
# If we we already have an IO::File object, return it, otherwise create one. |
306
|
26
|
|
|
|
|
136
|
require Scalar::Util; |
307
|
|
|
|
|
|
|
|
308
|
26
|
50
|
33
|
|
|
214
|
if ( Scalar::Util::blessed($q->{$field}) && $q->{$field}->isa('IO::File') ) { |
309
|
0
|
|
|
|
|
0
|
return $q->{$field}; |
310
|
|
|
|
|
|
|
} |
311
|
|
|
|
|
|
|
else { |
312
|
26
|
|
|
|
|
133
|
return IO::File->new_from_fd(fileno($q->{$field}), 'r'); |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
## returns mime type if included as part of the send |
317
|
|
|
|
|
|
|
## |
318
|
|
|
|
|
|
|
## NOTE: retrieves from original uploaded, -UNFILTERED- data |
319
|
|
|
|
|
|
|
sub _get_upload_mime_type |
320
|
|
|
|
|
|
|
{ |
321
|
8
|
|
|
8
|
|
17
|
my $self = shift; |
322
|
8
|
|
|
|
|
45
|
my $q = $self->get_input_data; |
323
|
8
|
|
|
|
|
30
|
my $field = $self->get_current_constraint_field; |
324
|
|
|
|
|
|
|
|
325
|
8
|
50
|
|
|
|
63
|
if ($q->isa('CGI')) { |
326
|
8
|
|
|
|
|
54
|
my $fn = $q->param($field); |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
## nicely check for info |
329
|
8
|
50
|
|
|
|
240
|
if ($q->uploadInfo($fn)) { |
330
|
8
|
|
|
|
|
336
|
return $q->uploadInfo($fn)->{'Content-Type'} |
331
|
|
|
|
|
|
|
} |
332
|
|
|
|
|
|
|
|
333
|
0
|
|
|
|
|
|
return undef; |
334
|
|
|
|
|
|
|
} |
335
|
|
|
|
|
|
|
|
336
|
0
|
0
|
|
|
|
|
if ($q->isa('CGI::Simple')) { |
337
|
0
|
|
|
|
|
|
my $fn = $q->param($field); |
338
|
0
|
|
|
|
|
|
return $q->upload_info($fn, 'mime'); |
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
|
341
|
0
|
0
|
|
|
|
|
if ($q->isa('Apache::Request')) { |
342
|
0
|
|
|
|
|
|
my $upload = $q->upload($field); |
343
|
0
|
|
|
|
|
|
return $upload->info('Content-type'); |
344
|
|
|
|
|
|
|
} |
345
|
|
|
|
|
|
|
|
346
|
0
|
|
|
|
|
|
return undef; |
347
|
|
|
|
|
|
|
} |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
1; |
351
|
|
|
|
|
|
|
__END__ |