File Coverage

blib/lib/HTML/Widget/Element/Upload.pm
Criterion Covered Total %
statement 18 18 100.0
branch 1 2 50.0
condition n/a
subroutine 5 5 100.0
pod 2 2 100.0
total 26 27 96.3


line stmt bran cond sub pod time code
1             package HTML::Widget::Element::Upload;
2              
3 88     88   102190 use warnings;
  88         203  
  88         2727  
4 88     88   503 use strict;
  88         474  
  88         4300  
5 88     88   468 use base 'HTML::Widget::Element';
  88         177  
  88         30547  
6              
7             __PACKAGE__->mk_accessors(qw/comment label/);
8             __PACKAGE__->mk_attr_accessors(qw/accept maxlength size/);
9              
10             =head1 NAME
11              
12             HTML::Widget::Element::Upload - Upload Element
13              
14             =head1 SYNOPSIS
15              
16             my $e = $widget->element( 'Upload', 'foo' );
17             $e->comment('(Required)');
18             $e->label('Foo');
19             $e->accept('text/html');
20             $e->maxlength(1000);
21             $e->size(23);
22              
23             =head1 DESCRIPTION
24              
25             Upload Element.
26              
27             Adding an Upload element automatically calls
28             C<$widget->enctype('multipart/form-data')> for you.
29              
30             =head1 METHODS
31              
32             =head2 accept
33              
34             Arguments: $type
35              
36             A comma-separated list of media types, as per C.
37              
38             =head2 prepare
39              
40             =cut
41              
42             sub prepare {
43 4     4 1 8 my ( $self, $w ) = @_;
44              
45             # force multipart
46 4         14 $w->enctype('multipart/form-data');
47              
48 4         13 return;
49             }
50              
51             =head2 containerize
52              
53             =cut
54              
55             sub containerize {
56 4     4 1 10 my ( $self, $w, $value, $errors ) = @_;
57              
58 4 50       13 $value = ref $value eq 'ARRAY' ? shift @$value : $value;
59              
60 4         19 my $l = $self->mk_label( $w, $self->label, $self->comment, $errors );
61 4         33 my $i = $self->mk_input( $w, { type => 'file', value => $value }, $errors );
62 4         23 my $e = $self->mk_error( $w, $errors );
63              
64 4         33 return $self->container( { element => $i, error => $e, label => $l } );
65             }
66              
67             =head1 SEE ALSO
68              
69             L
70              
71             =head1 AUTHOR
72              
73             Sebastian Riedel, C
74              
75             =head1 LICENSE
76              
77             This library is free software, you can redistribute it and/or modify it under
78             the same terms as Perl itself.
79              
80             =cut
81              
82             1;