File Coverage

blib/lib/HTML/FormFu/Constraint/File/MIME.pm
Criterion Covered Total %
statement 27 29 93.1
branch 9 12 75.0
condition 4 6 66.6
subroutine 7 7 100.0
pod 0 1 0.0
total 47 55 85.4


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