File Coverage

blib/lib/Perl/Critic/PolicyParameter/Behavior/Integer.pm
Criterion Covered Total %
statement 47 50 94.0
branch 12 16 75.0
condition 13 15 86.6
subroutine 8 8 100.0
pod 2 2 100.0
total 82 91 90.1


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