File Coverage

blib/lib/Perl/ToPerl6/TransformerParameter/Behavior/Integer.pm
Criterion Covered Total %
statement 14 52 26.9
branch 0 18 0.0
condition 0 12 0.0
subroutine 5 8 62.5
pod 2 2 100.0
total 21 92 22.8


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