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   715 use 5.010001;
  40         143  
4 40     40   241 use strict;
  40         83  
  40         869  
5 40     40   229 use warnings;
  40         96  
  40         1635  
6              
7 40     40   268 use Perl::Critic::Utils qw{ :characters };
  40         148  
  40         2106  
8              
9 40     40   8836 use parent qw{ Perl::Critic::PolicyParameter::Behavior };
  40         1333  
  40         224  
10              
11             our $VERSION = '1.150';
12              
13             #-----------------------------------------------------------------------------
14              
15             sub initialize_parameter {
16 1257     1257 1 3307 my ($self, $parameter, $specification) = @_;
17              
18 1257         2822 my $minimum = $specification->{integer_minimum};
19 1257         2555 my $maximum = $specification->{integer_maximum};
20              
21 1257         4118 $parameter->_get_behavior_values()->{minimum} = $minimum;
22 1257         3342 $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 1260     1260   3423 my ($policy, $parameter, $config_string) = @_; ## no critic(Variables::ProhibitReusedNames)
30              
31 1260   100     5643 my $value_string = $config_string // $parameter->get_default_string();
32              
33 1260         2705 my $value;
34 1260 100       3292 if ( defined $value_string ) {
35 1259 100 100     8810 if (
36             $value_string !~ m/ \A [-+]? [1-9] [\d_]* \z /xms
37             and $value_string ne '0'
38             ) {
39 1         5 $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 1258         4057 $value_string =~ tr/_//d;
48 1258         4016 $value = $value_string + 0;
49              
50 1258 100 100     5517 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 1256 100 100     4110 if ( defined $maximum and $maximum < $value ) {
60 2         10 $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 1255         6300 $policy->__set_parameter_value($parameter, $value);
70 1255         2960 return;
71             }
72 1257         9818 );
73              
74 1257         3047 return;
75             }
76              
77             #-----------------------------------------------------------------------------
78              
79             sub generate_parameter_description {
80 126     126 1 291 my ($self, $parameter) = @_;
81              
82 126         329 my $minimum = $parameter->_get_behavior_values()->{minimum};
83 126         305 my $maximum = $parameter->_get_behavior_values()->{maximum};
84              
85 126         312 my $description = $parameter->_get_description_with_trailing_period();
86 126 50       359 if ( $description ) {
87 126         419 $description .= qq{\n};
88             }
89              
90 126 50 33     437 if (defined $minimum or defined $maximum) {
91 126 50       343 if (defined $minimum) {
92 126         323 $description .= "Minimum value $minimum. ";
93             } else {
94 0         0 $description .= 'No minimum. ';
95             }
96              
97 126 50       282 if (defined $maximum) {
98 0         0 $description .= "Maximum value $maximum.";
99             } else {
100 126         275 $description .= 'No maximum.';
101             }
102             } else {
103 0         0 $description .= 'No limits.';
104             }
105              
106 126         376 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 :