File Coverage

blib/lib/Perl/ToPerl6/TransformerParameter/Behavior/Integer.pm
Criterion Covered Total %
statement 37 52 71.1
branch 10 18 55.5
condition 9 12 75.0
subroutine 7 8 87.5
pod 2 2 100.0
total 65 92 70.6


line stmt bran cond sub pod time code
1             package Perl::ToPerl6::TransformerParameter::Behavior::Integer;
2              
3 23     23   391 use 5.006001;
  23         64  
4 23     23   91 use strict;
  23         35  
  23         639  
5 23     23   90 use warnings;
  23         32  
  23         581  
6              
7 23     23   89 use Perl::ToPerl6::Utils qw{ :characters };
  23         31  
  23         1258  
8              
9 23     23   4020 use base qw{ Perl::ToPerl6::TransformerParameter::Behavior };
  23         35  
  23         10070  
10              
11             our $VERSION = '0.03';
12              
13             #-----------------------------------------------------------------------------
14              
15             sub initialize_parameter {
16 5     5 1 8 my ($self, $parameter, $specification) = @_;
17              
18 5         6 my $minimum = $specification->{integer_minimum};
19 5         8 my $maximum = $specification->{integer_maximum};
20              
21 5         13 $parameter->_get_behavior_values()->{minimum} = $minimum;
22 5         12 $parameter->_get_behavior_values()->{maximum} = $maximum;
23              
24             $parameter->_set_parser(
25             sub {
26             # Normally bad thing, obscuring a variable in a outer scope
27             # with a variable with the same name is being done here in
28             # order to remain consistent with the parser function interface.
29 22     22   26 my ($transformer, $parameter, $config_string) = @_;
30              
31 22         49 my $value_string = $parameter->get_default_string();
32              
33 22 100       42 if (defined $config_string) {
34 20         20 $value_string = $config_string;
35             }
36              
37 22         16 my $value;
38 22 100       39 if ( defined $value_string ) {
39 21 100 100     98 if (
40             $value_string !~ m/ \A [-+]? [1-9] [\d_]* \z /xms
41             and $value_string ne '0'
42             ) {
43 1         3 $transformer->throw_parameter_value_exception(
44             $parameter->get_name(),
45             $value_string,
46             undef,
47             'does not look like an integer.',
48             );
49             }
50              
51 20         36 $value_string =~ tr/_//d;
52 20         39 $value = $value_string + 0;
53              
54 20 100 100     54 if ( defined $minimum and $minimum > $value ) {
55 2         5 $transformer->throw_parameter_value_exception(
56             $parameter->get_name(),
57             $value_string,
58             undef,
59             qq{is less than $minimum.},
60             );
61             }
62              
63 18 100 100     51 if ( defined $maximum and $maximum < $value ) {
64 2         5 $transformer->throw_parameter_value_exception(
65             $parameter->get_name(),
66             $value_string,
67             undef,
68             qq{is greater than $maximum.},
69             );
70             }
71             }
72              
73 17         39 $transformer->__set_parameter_value($parameter, $value);
74 17         27 return;
75             }
76 5         31 );
77              
78 5         8 return;
79             }
80              
81             #-----------------------------------------------------------------------------
82              
83             sub generate_parameter_description {
84 0     0 1   my ($self, $parameter) = @_;
85              
86 0           my $minimum = $parameter->_get_behavior_values()->{minimum};
87 0           my $maximum = $parameter->_get_behavior_values()->{maximum};
88              
89 0           my $description = $parameter->_get_description_with_trailing_period();
90 0 0         if ( $description ) {
91 0           $description .= qq{\n};
92             }
93              
94 0 0 0       if (defined $minimum or defined $maximum) {
95 0 0         if (defined $minimum) {
96 0           $description .= "Minimum value $minimum. ";
97             } else {
98 0           $description .= 'No minimum. ';
99             }
100              
101 0 0         if (defined $maximum) {
102 0           $description .= "Maximum value $maximum.";
103             } else {
104 0           $description .= 'No maximum.';
105             }
106             } else {
107 0           $description .= 'No limits.';
108             }
109              
110 0           return $description;
111             }
112              
113             #-----------------------------------------------------------------------------
114              
115             1;
116              
117             __END__
118              
119             #-----------------------------------------------------------------------------
120              
121             =pod
122              
123             =for stopwords
124              
125             =head1 NAME
126              
127             Perl::ToPerl6::TransformerParameter::Behavior::Integer - Actions appropriate for an integer parameter.
128              
129              
130             =head1 DESCRIPTION
131              
132             Provides a standard set of functionality for an integer
133             L<Perl::ToPerl6::TransformerParameter|Perl::ToPerl6::TransformerParameter> so that
134             the developer of a transformer does not have to provide it her/himself.
135              
136             The parser provided by this behavior allows underscores ("_") in input
137             values as in a Perl numeric literal.
138              
139             NOTE: Do not instantiate this class. Use the singleton instance held
140             onto by
141             L<Perl::ToPerl6::TransformerParameter|Perl::ToPerl6::TransformerParameter>.
142              
143              
144             =head1 INTERFACE SUPPORT
145              
146             This is considered to be a non-public class. Its interface is subject
147             to change without notice.
148              
149              
150             =head1 METHODS
151              
152             =over
153              
154             =item C<initialize_parameter( $parameter, $specification )>
155              
156             Plug in the functionality this behavior provides into the parameter,
157             based upon the configuration provided by the specification.
158              
159             This behavior looks for two configuration items:
160              
161             =over
162              
163             =item integer_minimum
164              
165             Optional. The minimum acceptable value. Inclusive.
166              
167              
168             =item integer_maximum
169              
170             Optional. The maximum acceptable value. Inclusive.
171              
172              
173             =back
174              
175              
176             =item C<generate_parameter_description( $parameter )>
177              
178             Create a description of the parameter, based upon the description on
179             the parameter itself, but enhancing it with information from this
180             behavior.
181              
182             In this case, this means including the minimum and maximum values.
183              
184              
185             =back
186              
187              
188             =head1 AUTHOR
189              
190             Elliot Shank <perl@galumph.com>
191              
192              
193             =head1 COPYRIGHT
194              
195             Copyright (c) 2007-2011 Elliot Shank.
196              
197             This program is free software; you can redistribute it and/or modify
198             it under the same terms as Perl itself. The full text of this license
199             can be found in the LICENSE file included with this module.
200              
201             =cut
202              
203             # Local Variables:
204             # mode: cperl
205             # cperl-indent-level: 4
206             # fill-column: 78
207             # indent-tabs-mode: nil
208             # c-indentation-style: bsd
209             # End:
210             # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :