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