File Coverage

blib/lib/Data/MuForm/Field/Text.pm
Criterion Covered Total %
statement 28 33 84.8
branch 15 22 68.1
condition 2 3 66.6
subroutine 7 8 87.5
pod 1 5 20.0
total 53 71 74.6


line stmt bran cond sub pod time code
1             package Data::MuForm::Field::Text;
2             # ABSTRACT: Text field
3 84     84   106455 use Moo;
  84         23938  
  84         443  
4             extends 'Data::MuForm::Field';
5 84     84   20577 use List::Util ('all');
  84         114  
  84         33096  
6              
7             has 'size' => ( is => 'rw', default => 0 );
8             has 'maxlength' => ( is => 'rw' );
9             has 'minlength' => ( is => 'rw', default => '0' );
10              
11 33     33 0 1872 sub build_input_type { 'text' }
12              
13             our $class_messages = {
14             'text_maxlength' => 'Field should not exceed {maxlength} characters. You entered {length}',
15             'text_minlength' => 'Field must be at least {minlength} characters. You entered {length}',
16             'multiple_values_disallowed' => 'Field must contain a single value',
17             };
18              
19             sub get_class_messages {
20 42     42 0 188 my $self = shift;
21             my $messages = {
22 42         42 %{ $self->next::method },
  42         96  
23             %$class_messages,
24             };
25 42         400 return $messages;
26             }
27              
28             sub base_render_args {
29 42     42 0 601 my $self = shift;
30 42         147 my $args = $self->next::method(@_);
31 42 100       125 $args->{element_attr}->{size} = $self->size if $self->size;
32 42 100       128 $args->{element_attr}->{maxlength} = $self->maxlength if $self->maxlength;
33 42 50       106 $args->{element_attr}->{minlength} = $self->minlenght if $self->minlength;
34 42         155 return $args;
35             }
36              
37             sub normalize_input {
38 383     383 0 379 my $self = shift;
39              
40 383         651 my $input = $self->input;
41 383 50 66     1101 if ( ref $input eq 'ARRAY' && ! $self->multiple ) {
42 0 0       0 if ( scalar @$input == 0 ) {
    0          
43 0         0 $self->input('');
44             }
45 0     0   0 elsif ( all { $_ eq $input->[0] } @$input ) {
46 0         0 $self->input($input->[0]);
47             }
48             else {
49 0         0 $self->add_error( $self->get_message('multiple_values_disallowed') );
50             }
51             }
52             }
53              
54             sub validate {
55 301     301 1 311 my $self = shift;
56              
57 301 50       1030 return unless $self->next::method;
58 301         480 my $value = $self->value;
59             # Check for max length
60 301 100       728 if ( my $maxlength = $self->maxlength ) {
61 11 100       34 return $self->add_error( $self->get_message('text_maxlength'),
62             maxlength => $maxlength, length => length $value, field_label =>$self->loc_label )
63             if length $value > $maxlength;
64             }
65              
66             # Check for min length
67 298 100       694 if ( my $minlength = $self->minlength ) {
68 6 100       14 return $self->add_error(
69             $self->get_message('text_minlength'),
70             minlength => $minlength, length => length $value, field_label => $self->loc_label )
71             if length $value < $minlength;
72             }
73 296         410 return 1;
74             }
75              
76             1;
77              
78             __END__
79              
80             =pod
81              
82             =encoding UTF-8
83              
84             =head1 NAME
85              
86             Data::MuForm::Field::Text - Text field
87              
88             =head1 VERSION
89              
90             version 0.03
91              
92             =head1 AUTHOR
93              
94             Gerda Shank
95              
96             =head1 COPYRIGHT AND LICENSE
97              
98             This software is copyright (c) 2017 by Gerda Shank.
99              
100             This is free software; you can redistribute it and/or modify it under
101             the same terms as the Perl 5 programming language system itself.
102              
103             =cut