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