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   752 use 5.010001;
  40         158  
4 40     40   228 use strict;
  40         1377  
  40         1034  
5 40     40   229 use warnings;
  40         90  
  40         1279  
6              
7 40     40   313 use Perl::Critic::Utils qw{ :characters };
  40         112  
  40         2236  
8              
9 40     40   8980 use parent qw{ Perl::Critic::PolicyParameter::Behavior };
  40         106  
  40         1552  
10              
11             our $VERSION = '1.146';
12              
13             #-----------------------------------------------------------------------------
14              
15             sub initialize_parameter {
16 1388     1388 1 4424 my ($self, $parameter, $specification) = @_;
17              
18 1388         4094 my $minimum = $specification->{integer_minimum};
19 1388         3284 my $maximum = $specification->{integer_maximum};
20              
21 1388         5064 $parameter->_get_behavior_values()->{minimum} = $minimum;
22 1388         4032 $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 1391     1391   4116 my ($policy, $parameter, $config_string) = @_; ## no critic(Variables::ProhibitReusedNames)
30              
31 1391   100     6971 my $value_string = $config_string // $parameter->get_default_string();
32              
33 1391         3065 my $value;
34 1391 100       4710 if ( defined $value_string ) {
35 1390 100 100     10879 if (
36             $value_string !~ m/ \A [-+]? [1-9] [\d_]* \z /xms
37             and $value_string ne '0'
38             ) {
39 1         6 $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 1389         4657 $value_string =~ tr/_//d;
48 1389         4825 $value = $value_string + 0;
49              
50 1389 100 100     6750 if ( defined $minimum and $minimum > $value ) {
51 2         5 $policy->throw_parameter_value_exception(
52             $parameter->get_name(),
53             $value_string,
54             undef,
55             qq{is less than $minimum.},
56             );
57             }
58              
59 1387 100 100     4705 if ( defined $maximum and $maximum < $value ) {
60 2         9 $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 1386         7606 $policy->__set_parameter_value($parameter, $value);
70 1386         3370 return;
71             }
72 1388         12174 );
73              
74 1388         4126 return;
75             }
76              
77             #-----------------------------------------------------------------------------
78              
79             sub generate_parameter_description {
80 126     126 1 286 my ($self, $parameter) = @_;
81              
82 126         335 my $minimum = $parameter->_get_behavior_values()->{minimum};
83 126         295 my $maximum = $parameter->_get_behavior_values()->{maximum};
84              
85 126         301 my $description = $parameter->_get_description_with_trailing_period();
86 126 50       361 if ( $description ) {
87 126         415 $description .= qq{\n};
88             }
89              
90 126 50 33     357 if (defined $minimum or defined $maximum) {
91 126 50       273 if (defined $minimum) {
92 126         287 $description .= "Minimum value $minimum. ";
93             } else {
94 0         0 $description .= 'No minimum. ';
95             }
96              
97 126 50       256 if (defined $maximum) {
98 0         0 $description .= "Maximum value $maximum.";
99             } else {
100 126         264 $description .= 'No maximum.';
101             }
102             } else {
103 0         0 $description .= 'No limits.';
104             }
105              
106 126         397 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 :