File Coverage

blib/lib/HTML/Form/FileInput.pm
Criterion Covered Total %
statement 43 43 100.0
branch 18 22 81.8
condition 7 11 63.6
subroutine 7 7 100.0
pod 0 5 0.0
total 75 88 85.2


line stmt bran cond sub pod time code
1             package HTML::Form::FileInput;
2              
3 11     11   74 use strict;
  11         18  
  11         363  
4 11     11   55 use parent 'HTML::Form::TextInput';
  11         27  
  11         50  
5              
6             our $VERSION = '6.11';
7              
8             # ABSTRACT: An HTML form file input element for use with HTML::Form
9              
10             sub file {
11 32     32 0 84 my $self = shift;
12 32         72 $self->value(@_);
13             }
14              
15             sub filename {
16 16     16 0 32 my $self = shift;
17 16         24 my $old = $self->{filename};
18 16 100       35 $self->{filename} = shift if @_;
19 16 100       38 $old = $self->file unless defined $old;
20 16         29 $old;
21             }
22              
23             sub content {
24 15     15 0 24 my $self = shift;
25 15         24 my $old = $self->{content};
26 15 100       27 $self->{content} = shift if @_;
27 15         23 $old;
28             }
29              
30             sub headers {
31 13     13 0 18 my $self = shift;
32 13   50     45 my $old = $self->{headers} || [];
33 13 50       29 $self->{headers} = [@_] if @_;
34 13         27 @$old;
35             }
36              
37             sub form_name_value {
38 14     14 0 68 my ( $self, $form ) = @_;
39 14 100 66     33 return $self->SUPER::form_name_value($form)
40             if $form->method ne "POST"
41             || $form->enctype ne "multipart/form-data";
42              
43 13         66 my $name = $self->name;
44 13 50       28 return unless defined $name;
45 13 50       29 return if $self->{disabled};
46              
47 13         27 my $file = $self->file;
48 13         26 my $filename = $self->filename;
49 13         29 my @headers = $self->headers;
50 13         25 my $content = $self->content;
51 13         27 my %headers = @headers;
52 13 100 66     94 if ( defined $content || grep m/^Content$/i, keys %headers ) {
    100 66        
53 2 50       5 $filename = $file unless defined $filename;
54 2         3 $file = undef;
55 2         6 unshift( @headers, "Content" => $content );
56             }
57             elsif ( !defined($file) || length($file) == 0 ) {
58 1         4 return;
59             }
60              
61             # legacy (this used to be the way to do it)
62 12 100       32 if ( ref($file) eq "ARRAY" ) {
63 7         11 my $f = shift @$file;
64 7         12 my $fn = shift @$file;
65 7         12 push( @headers, @$file );
66 7         11 $file = $f;
67 7         11 $filename = $fn;
68             }
69              
70 12         70 return ( $name => [ $file, $filename, @headers ] );
71             }
72              
73             1;
74              
75             __END__