1 ##############################################################################
2 # $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/lib/Perl/Critic/PolicyParameter/Behavior/Enumeration.pm $
3 # $Date: 2008-07-03 10:19:10 -0500 (Thu, 03 Jul 2008) $
6 ##############################################################################
8 package Perl::Critic::PolicyParameter::Behavior::Enumeration;
14 use Perl::Critic::Exception::Fatal::PolicyDefinition
15 qw{ &throw_policy_definition };
16 use Perl::Critic::Utils qw{ :characters &words_from_string &hashify };
18 use base qw{ Perl::Critic::PolicyParameter::Behavior };
20 our $VERSION = '1.088';
22 #-----------------------------------------------------------------------------
24 sub initialize_parameter {
25 my ($self, $parameter, $specification) = @_;
27 my $valid_values = $specification->{enumeration_values}
28 or throw_policy_definition
29 'No enumeration_values given for '
30 . $parameter->get_name()
32 ref $valid_values eq 'ARRAY'
33 or throw_policy_definition
34 'The value given for enumeration_values for '
35 . $parameter->get_name()
36 . ' is not an array reference.';
37 scalar @{$valid_values} > 1
38 or throw_policy_definition
39 'There were not at least two valid values given for'
40 . ' enumeration_values for '
41 . $parameter->get_name()
44 # Unfortunately, this has to be a reference, rather than a regular hash,
45 # due to a problem in Devel::Cycle
46 # (http://rt.cpan.org/Ticket/Display.html?id=25360) which causes
47 # t/92_memory_leaks.t to fall over.
48 my $value_lookup = { hashify( @{$valid_values} ) };
49 $parameter->_get_behavior_values()->{enumeration_values} = $value_lookup;
51 my $allow_multiple_values =
52 $specification->{enumeration_allow_multiple_values};
54 if ($allow_multiple_values) {
55 $parameter->_set_parser(
57 # Normally bad thing, obscuring a variable in a outer scope
58 # with a variable with the same name is being done here in
59 # order to remain consistent with the parser function interface.
60 my ($policy, $parameter, $config_string) = @_;
63 my $value_string = $parameter->get_default_string();
65 if (defined $config_string) {
66 $value_string = $config_string;
69 if ( defined $value_string ) {
70 @potential_values = words_from_string($value_string);
73 grep { not exists $value_lookup->{$_} } @potential_values;
75 $policy->throw_parameter_value_exception(
76 $parameter->get_name(),
79 q{contains invalid values: }
80 . join (q{, }, @bad_values)
81 . q{. Allowed values are: }
82 . join (q{, }, sort keys %{$value_lookup})
88 my %actual_values = hashify(@potential_values);
90 $policy->__set_parameter_value($parameter, \%actual_values);
96 $parameter->_set_parser(
98 # Normally bad thing, obscuring a variable in a outer scope
99 # with a variable with the same name is being done here in
100 # order to remain consistent with the parser function interface.
101 my ($policy, $parameter, $config_string) = @_;
103 my $value_string = $parameter->get_default_string();
105 if (defined $config_string) {
106 $value_string = $config_string;
110 defined $value_string
111 and $EMPTY ne $value_string
112 and not defined $value_lookup->{$value_string}
114 $policy->throw_parameter_value_exception(
115 $parameter->get_name(),
118 q{is not one of the allowed values: }
119 . join (q{, }, sort keys %{$value_lookup})
124 $policy->__set_parameter_value($parameter, $value_string);
134 #-----------------------------------------------------------------------------
136 sub generate_parameter_description {
137 my ($self, $parameter) = @_;
139 my $description = $parameter->_get_description_with_trailing_period();
140 if ( $description ) {
141 $description .= qq{\n};
144 my %values = %{$parameter->_get_behavior_values()->{enumeration_values}};
148 . join (', ', sort keys %values)
152 #-----------------------------------------------------------------------------
158 #-----------------------------------------------------------------------------
166 Perl::Critic::PolicyParameter::Behavior::Enumeration - Actions appropriate for an enumerated value.
171 Provides a standard set of functionality for an enumerated
172 L<Perl::Critic::PolicyParameter> so that the developer of a policy
173 does not have to provide it her/himself.
175 NOTE: Do not instantiate this class. Use the singleton instance held
176 onto by L<Perl::Critic::PolicyParameter>.
183 =item C<initialize_parameter( $parameter, $specification )>
185 Plug in the functionality this behavior provides into the parameter,
186 based upon the configuration provided by the specification.
188 This behavior looks for two configuration items:
192 =item enumeration_values
194 Mandatory. The set of valid values for the parameter, as an array
197 =item enumeration_allow_multiple_values
199 Optional, defaults to false. Should the parameter support a single
200 value or accept multiple?
204 =item C<generate_parameter_description( $parameter )>
206 Create a description of the parameter, based upon the description on
207 the parameter itself, but enhancing it with information from this
210 In this specific case, the universe of values is added at the end.
217 Elliot Shank <perl@galumph.com>
221 Copyright (c) 2006-2008 Elliot Shank. All rights reserved.
223 This program is free software; you can redistribute it and/or modify
224 it under the same terms as Perl itself. The full text of this license
225 can be found in the LICENSE file included with this module.
231 # cperl-indent-level: 4
233 # indent-tabs-mode: nil
234 # c-indentation-style: bsd
236 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :