File Coverage

blib/lib/HTML/Widget/Element/Textarea.pm
Criterion Covered Total %
statement 31 31 100.0
branch 5 6 83.3
condition 7 8 87.5
subroutine 7 7 100.0
pod 2 2 100.0
total 52 54 96.3


line stmt bran cond sub pod time code
1             package HTML::Widget::Element::Textarea;
2              
3 88     88   77766 use warnings;
  88         199  
  88         3013  
4 88     88   502 use strict;
  88         184  
  88         2934  
5 88     88   507 use base 'HTML::Widget::Element';
  88         189  
  88         7614  
6 88     88   541 use HTML::Element;
  88         189  
  88         837  
7 88     88   2194 use NEXT;
  88         182  
  88         605  
8              
9             __PACKAGE__->mk_accessors(qw/comment label value retain_default/);
10             __PACKAGE__->mk_attr_accessors(qw/cols rows wrap/);
11              
12             =head1 NAME
13              
14             HTML::Widget::Element::Textarea - Textarea Element
15              
16             =head1 SYNOPSIS
17              
18             my $e = $widget->element( 'Textarea', 'foo' );
19             $e->comment('(Required)');
20             $e->label('Foo');
21             $e->cols(30);
22             $e->rows(40);
23             $e->value('bar');
24             $e->wrap('wrap');
25              
26             =head1 DESCRIPTION
27              
28             Textarea Element.
29              
30             =head1 METHODS
31              
32             =head2 new
33              
34             Create new textarea with default size of 20 rows and 40 columns
35              
36             =cut
37              
38             sub new {
39 8     8 1 92 shift->NEXT::new(@_)->rows(20)->cols(40);
40             }
41              
42             =head2 containerize
43              
44             =cut
45              
46             sub containerize {
47 10     10 1 25 my ( $self, $w, $value, $errors, $args ) = @_;
48              
49 10 100 100     56 $value = $self->value
      66        
50             if ( not defined $value )
51             and $self->retain_default || not $args->{submitted};
52              
53 10 50       133 $value = ref $value eq 'ARRAY' ? shift @$value : $value;
54              
55 10         41 my $l = $self->mk_label( $w, $self->label, $self->comment, $errors );
56              
57 10   100     48 $self->attributes->{class} ||= 'textarea';
58 10         35 my $i = HTML::Element->new('textarea');
59 10 100       209 $i->push_content($value) if defined $value;
60 10         140 my $id = $self->id($w);
61 10         95 $i->attr( id => $id );
62 10         128 $i->attr( name => $self->name );
63              
64 10         33 $i->attr( $_ => ${ $self->attributes }{$_} )
  32         272  
65 10         129 for ( keys %{ $self->attributes } );
66              
67 10         154 my $e = $self->mk_error( $w, $errors );
68              
69 10         73 return $self->container( { element => $i, error => $e, label => $l } );
70             }
71              
72             =head2 label
73              
74             =head2 value
75              
76             =head2 cols
77              
78             =head2 rows
79              
80             =head2 wrap
81              
82             =head2 retain_default
83              
84             If true, overrides the default behaviour, so that after a field is missing
85             from the form submission, the xml output will contain the default value,
86             rather than be empty.
87              
88             =head1 SEE ALSO
89              
90             L
91              
92             =head1 AUTHOR
93              
94             Sebastian Riedel, C
95              
96             =head1 LICENSE
97              
98             This library is free software, you can redistribute it and/or modify it under
99             the same terms as Perl itself.
100              
101             =cut
102              
103             1;