File Coverage

blib/lib/Data/MuForm/Field/Currency.pm
Criterion Covered Total %
statement 21 21 100.0
branch 3 6 50.0
condition n/a
subroutine 9 9 100.0
pod 0 2 0.0
total 33 38 86.8


line stmt bran cond sub pod time code
1             package Data::MuForm::Field::Currency;
2             # ABSTRACT: US currency-like values
3              
4 1     1   917 use Moo;
  1         7888  
  1         5  
5             extends 'Data::MuForm::Field::Text';
6              
7             has '+html5_type_attr' => ( default => 'number' );
8             has 'currency_symbol' => (
9             is => 'ro',
10             default => '$',
11             );
12             has 'disallow_commas' => (
13             is => 'ro',
14             default => 0,
15             );
16              
17             our $class_messages = {
18             'currency_convert' => 'Cannot be converted to currency',
19             'currency_real' => 'Must be a real number',
20             };
21              
22             sub get_class_messages {
23 3     3 0 3 my $self = shift;
24             return {
25 3         2 %{ $self->next::method },
  3         8  
26             %$class_messages,
27             }
28             }
29              
30             sub build_base_apply {
31             return
32             [ { # remove any leading currency symbol
33             transform => sub {
34 3     3   4 my ( $value, $field ) = @_;
35 3         6 my $c = $field->currency_symbol;
36 3 50       26 $value =~ s/^\Q$c\E// if $c;
37 3         8 return $value;
38             },
39             },
40             { # check number looks real, optionally allow comma digit groupings
41             check => sub {
42 3     3   4 my ( $value, $field ) = @_;
43 3 50       21 return $field->disallow_commas
44             ? $value =~ /^[-+]?\d+(?:\.\d+)?$/
45             : $value =~ /^[-+]?(?:\d+|\d{1,3}(,\d{3})*)(?:\.\d+)?$/;
46             },
47             message => sub {
48 1     1   2 my ( $value, $field ) = @_;
49 1         3 return [ $field->get_message('currency_real'), $value ];
50             },
51             },
52             { # remove commas
53             transform => sub {
54 3     3   3 my ($value, $field) = @_;
55 3 50       11 $value =~ tr/,//d unless $field->disallow_commas;
56 3         5 return $value;
57             },
58             },
59             { # convert to standard number, formatted to 2 decimal palaces
60 3     3   36 transform => sub { sprintf '%.2f', $_[0] },
61             message => sub {
62 1     1   2 my ( $value, $field ) = @_;
63 1         4 return [ $field->get_message('currency_convert'), $value ];
64             },
65             },
66 1     1 0 32 ];
67             }
68              
69              
70              
71             1;
72              
73             __END__
74              
75             =pod
76              
77             =encoding UTF-8
78              
79             =head1 NAME
80              
81             Data::MuForm::Field::Currency - US currency-like values
82              
83             =head1 VERSION
84              
85             version 0.03
86              
87             =head1 DESCRIPTION
88              
89             Validates that a positive or negative real value is entered.
90             Formatted with two decimal places.
91              
92             Uses a period for the decimal point.
93              
94             If form has 'is_html5' flag active it will render <input type="number" ... />
95             instead of type="text"
96              
97             =head1 ATTRIBUTES
98              
99             =head2
100              
101             =over
102              
103             =item currency_symbol
104              
105             Currency symbol to remove from start of input if found, default is dollar
106             C<$>.
107              
108             =item disallow_commas
109              
110             Don't Allow commas in input for digit grouping? Digits are grouped into groups of 3,
111             for example C<1,000,000,000>. Defaults to I<false>.
112              
113             =back
114              
115             =head1 AUTHOR
116              
117             Gerda Shank
118              
119             =head1 COPYRIGHT AND LICENSE
120              
121             This software is copyright (c) 2017 by Gerda Shank.
122              
123             This is free software; you can redistribute it and/or modify it under
124             the same terms as the Perl 5 programming language system itself.
125              
126             =cut