1use strict;
2
3package HTML::FormFu::Constraint::File::MIME;
4$HTML::FormFu::Constraint::File::MIME::VERSION = '2.07';
5# ABSTRACT: MIME Type Constraint
6
7use Moose;
8use MooseX::Attribute::Chained;
9extends 'HTML::FormFu::Constraint';
10
11use List::Util 1.33 qw( any );
12use Scalar::Util qw( blessed );
13
14has regex => ( is => 'rw', traits => ['Chained'] );
15has types => ( is => 'rw', traits => ['Chained'] );
16
17sub constrain_value {
18    my ( $self, $value ) = @_;
19
20    return 1 if !defined $value || $value eq '';
21
22    return if !blessed($value) || !$value->isa('HTML::FormFu::Upload');
23
24    my $input = $value->headers->content_type;
25    my $types = $self->types;
26    my $regex = $self->regex;
27
28    if ( defined $types ) {
29        if ( ref $types ne 'ARRAY' ) {
30            $types = [$types];
31        }
32
33        return 1 if any { $input eq $_ } @$types;
34    }
35
36    if ( defined $regex ) {
37        return $input =~ /$regex/x;
38    }
39
40    return;
41}
42
43__PACKAGE__->meta->make_immutable;
44
451;
46
47__END__
48
49=pod
50
51=encoding UTF-8
52
53=head1 NAME
54
55HTML::FormFu::Constraint::File::MIME - MIME Type Constraint
56
57=head1 VERSION
58
59version 2.07
60
61=head1 DESCRIPTION
62
63Constraint an uploaded file's MIME-type (Content-Type).
64
65L</types> is checked before L</regex>.
66
67=head1 METHODS
68
69=head2 types
70
71Arguments: $mime_type
72
73Arguments: \@mime_types
74
75Optional.
76
77Accepts a single MIME-type or an arrayref of MIME-types. Each is checked
78against the uploaded file's MIME-type (as given by the browser), and the
79constraint passes if any one of the given types matches.
80
81=head2 regex
82
83Arguments: $regex
84
85Optional.
86
87Accepts a string to be interpreted as a regex, and is checked against the
88uploaded files's MIME-type (as given by the browser).
89
90The regex uses the C</x> flag, so that whitespace in the given string is
91ignored.
92
93=head1 SEE ALSO
94
95Is a sub-class of, and inherits methods from L<HTML::FormFu::Constraint>
96
97L<HTML::FormFu>
98
99=head1 AUTHOR
100
101Carl Franks, C<cfranks@cpan.org>
102
103=head1 LICENSE
104
105This library is free software, you can redistribute it and/or modify it under
106the same terms as Perl itself.
107
108=head1 AUTHOR
109
110Carl Franks <cpan@fireartist.com>
111
112=head1 COPYRIGHT AND LICENSE
113
114This software is copyright (c) 2018 by Carl Franks.
115
116This is free software; you can redistribute it and/or modify it under
117the same terms as the Perl 5 programming language system itself.
118
119=cut
120