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   719 use 5.010001;
  40         157  
4 40     40   239 use strict;
  40         95  
  40         2083  
5 40     40   225 use warnings;
  40         97  
  40         1263  
6              
7 40     40   229 use Perl::Critic::Utils qw{ :characters };
  40         131  
  40         2269  
8              
9 40     40   9152 use parent qw{ Perl::Critic::PolicyParameter::Behavior };
  40         102  
  40         1371  
10              
11             our $VERSION = '1.148';
12              
13             #-----------------------------------------------------------------------------
14              
15             sub initialize_parameter {
16 1388     1388 1 3670 my ($self, $parameter, $specification) = @_;
17              
18 1388         3153 my $minimum = $specification->{integer_minimum};
19 1388         2946 my $maximum = $specification->{integer_maximum};
20              
21 1388         5003 $parameter->_get_behavior_values()->{minimum} = $minimum;
22 1388         4311 $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 1391     1391   4098 my ($policy, $parameter, $config_string) = @_; ## no critic(Variables::ProhibitReusedNames)
30              
31 1391   100     6359 my $value_string = $config_string // $parameter->get_default_string();
32              
33 1391         2822 my $value;
34 1391 100       4215 if ( defined $value_string ) {
35 1390 100 100     10194 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         4473 $value_string =~ tr/_//d;
48 1389         4609 $value = $value_string + 0;
49              
50 1389 100 100     6574 if ( defined $minimum and $minimum > $value ) {
51 2         11 $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     4766 if ( defined $maximum and $maximum < $value ) {
60 2         8 $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         7223 $policy->__set_parameter_value($parameter, $value);
70 1386         3313 return;
71             }
72 1388         11646 );
73              
74 1388         3736 return;
75             }
76              
77             #-----------------------------------------------------------------------------
78              
79             sub generate_parameter_description {
80 126     126 1 384 my ($self, $parameter) = @_;
81              
82 126         366 my $minimum = $parameter->_get_behavior_values()->{minimum};
83 126         330 my $maximum = $parameter->_get_behavior_values()->{maximum};
84              
85 126         326 my $description = $parameter->_get_description_with_trailing_period();
86 126 50       407 if ( $description ) {
87 126         374 $description .= qq{\n};
88             }
89              
90 126 50 33     444 if (defined $minimum or defined $maximum) {
91 126 50       335 if (defined $minimum) {
92 126         367 $description .= "Minimum value $minimum. ";
93             } else {
94 0         0 $description .= 'No minimum. ';
95             }
96              
97 126 50       270 if (defined $maximum) {
98 0         0 $description .= "Maximum value $maximum.";
99             } else {
100 126         304 $description .= 'No maximum.';
101             }
102             } else {
103 0         0 $description .= 'No limits.';
104             }
105              
106 126         353 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 :