File Coverage

blib/lib/HTML/FormHandler/Field/Float.pm
Criterion Covered Total %
statement 29 36 80.5
branch 9 16 56.2
condition n/a
subroutine 5 6 83.3
pod 1 4 25.0
total 44 62 70.9


line stmt bran cond sub pod time code
1             package HTML::FormHandler::Field::Float;
2             # ABSTRACT: validate a float value
3             $HTML::FormHandler::Field::Float::VERSION = '0.40067';
4 2     2   1485 use HTML::FormHandler::Moose;
  2         4  
  2         16  
5             extends 'HTML::FormHandler::Field::Text';
6              
7             has '+size' => ( default => 8 );
8             has 'precision' => ( isa => 'Int|Undef', is => 'rw', default => 2 );
9             has 'decimal_symbol' => ( isa => 'Str', is => 'rw', default => '.');
10             has 'decimal_symbol_for_db' => ( isa => 'Str', is => 'rw', default => '.');
11             has '+inflate_method' => ( default => sub { \&inflate_float } );
12             has '+deflate_method' => ( default => sub { \&deflate_float } );
13              
14             our $class_messages = {
15             'float_needed' => 'Must be a number. May contain numbers, +, - and decimal separator \'[_1]\'',
16             'float_size' => 'Total size of number must be less than or equal to [_1], but is [_2]',
17             'float_precision' => 'May have a maximum of [quant,_1,digit] after the decimal point, but has [_2]',
18             };
19              
20             sub get_class_messages {
21 2     2 0 3 my $self = shift;
22             return {
23 2         2 %{ $self->next::method },
  2         12  
24             %$class_messages,
25             }
26             }
27              
28             sub inflate_float {
29 7     7 0 9 my ( $self, $value ) = @_;
30 7 50       16 return $value unless defined $value;
31 7         10 $value =~ s/^\+//;
32 7         16 return $value;
33             }
34              
35             sub deflate_float {
36 0     0 0 0 my ( $self, $value ) = @_;
37 0 0       0 return $value unless defined $value;
38 0         0 my $symbol = $self->decimal_symbol;
39 0         0 my $symbol_db = $self->decimal_symbol_for_db;
40 0         0 $value =~ s/\Q$symbol_db\E/$symbol/x;
41 0         0 return $value;
42             }
43              
44             sub validate {
45 7     7 1 9 my $field = shift;
46              
47             #return unless $field->next::method;
48 7         8 my ($integer_part, $decimal_part) = ();
49 7         12 my $value = $field->value;
50 7         177 my $symbol = $field->decimal_symbol;
51 7         185 my $symbol_db = $field->decimal_symbol_for_db;
52              
53 7 50       90 if ($value =~ m/^-?([0-9]+)(\Q$symbol\E([0-9]+))?$/x) { # \Q ... \E - All the characters between the \Q and the \E are interpreted as literal characters.
54 7         9 $integer_part = $1;
55 7 50       16 $decimal_part = defined $3 ? $3 : '';
56             }
57             else {
58 0         0 return $field->add_error( $field->get_message('float_needed'), $symbol );
59             }
60              
61 7 50       173 if ( my $allowed_size = $field->size ) {
62 7         10 my $total_size = length($integer_part) + length($decimal_part);
63 7 100       18 return $field->add_error( $field->get_message('float_size'),
64             $allowed_size, $total_size )
65             if $total_size > $allowed_size;
66             }
67              
68 6 50       148 if ( my $allowed_precision = $field->precision ) {
69 6 100       19 return $field->add_error( $field->get_message('float_precision'),
70             $allowed_precision, length $decimal_part)
71             if length $decimal_part > $allowed_precision;
72             }
73              
74             # Inflate to database accepted format
75 5         31 $value =~ s/\Q$symbol\E/$symbol_db/x;
76 5         19 $field->_set_value($value);
77              
78 5         11 return 1;
79             }
80              
81             __PACKAGE__->meta->make_immutable;
82 2     2   3767 use namespace::autoclean;
  2         3  
  2         17  
83             1;
84              
85             __END__
86              
87             =pod
88              
89             =encoding UTF-8
90              
91             =head1 NAME
92              
93             HTML::FormHandler::Field::Float - validate a float value
94              
95             =head1 VERSION
96              
97             version 0.40067
98              
99             =head1 DESCRIPTION
100              
101             This accepts a positive or negative float/integer. Negative numbers may
102             be prefixed with a dash. By default a max of eight digits including 2 precision
103             are accepted. Default decimal symbol is ','.
104             Widget type is 'text'.
105              
106             # For example 1234,12 has size of 6 and precision of 2
107             # and separator symbol of ','
108              
109             has_field 'test_result' => (
110             type => 'Float',
111             size => 8, # Total size of number including decimal part.
112             precision => 2, # Size of the part after decimal symbol.
113             decimal_symbol => '.', # Decimal symbol accepted in web page form
114             decimal_symbol_for_db => '.', # For inflation. Decimal symbol accepted in DB, which automatically converted to.
115             range_start => 0,
116             range_end => 100
117             );
118              
119             =head2 messages
120              
121             float_needed
122             float_size
123             float_precision
124              
125             =head1 AUTHOR
126              
127             FormHandler Contributors - see HTML::FormHandler
128              
129             =head1 COPYRIGHT AND LICENSE
130              
131             This software is copyright (c) 2016 by Gerda Shank.
132              
133             This is free software; you can redistribute it and/or modify it under
134             the same terms as the Perl 5 programming language system itself.
135              
136             =cut