git.maemo.org Git - pkg-perl/blob - deb-src/libperl-critic-perl/libperl-critic-perl-1.088/lib/Perl/Critic/PolicyParameter/Behavior/Integer.pm

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