Clean up some self-compliance issues now that MagicNumbers

[gknop/Perl-Critic.git] / lib / Perl / Critic / Policy / ValuesAndExpressions / ProhibitMagicNumbers.pm

##############################################################################
#      $URL$
#     $Date$
#   $Author$
# $Revision$
##############################################################################

package Perl::Critic::Policy::ValuesAndExpressions::ProhibitMagicNumbers;

use strict;
use warnings;

use Readonly;

use Perl::Critic::Utils qw{ :booleans :characters :severities :data_conversion };

use base 'Perl::Critic::Policy';

our $VERSION = '1.082';

#----------------------------------------------------------------------------

Readonly::Scalar my $EXPL =>
    q{Unnamed numeric literals make code less maintainable};
Readonly::Scalar my $USE_READONLY_OR_CONSTANT =>
    ' Use the Readonly module or the "constant" pragma instead';
Readonly::Scalar my $TYPE_NOT_ALLOWED_SUFFIX =>
    ") are not allowed.$USE_READONLY_OR_CONSTANT";

Readonly::Scalar my $UNSIGNED_NUMBER =>
    qr{
            \d+ (?: [$PERIOD] \d+ )?  # 1, 1.5, etc.
        |   [$PERIOD] \d+             # .3, .7, etc.
    }xms;
Readonly::Scalar my $SIGNED_NUMBER => qr/ [-+]? $UNSIGNED_NUMBER /xms;

# The regex is already simplified.  There's just a lot of variable use.
## no critic (ProhibitComplexRegexes)
Readonly::Scalar my $RANGE =>
    qr{
        \A
        ($SIGNED_NUMBER)
        [$PERIOD] [$PERIOD]
        ($SIGNED_NUMBER)
        (?:
            [$COLON] by [$LEFT_PAREN]
            ($UNSIGNED_NUMBER)
            [$RIGHT_PAREN]
        )?
        \z
    }xms;
## use critic

Readonly::Scalar my $SPECIAL_ARRAY_SUBSCRIPT_EXEMPTION => -1;

Readonly::Hash my %READONLY_SUBROUTINES =>
    hashify(
        qw{ Readonly Readonly::Scalar Readonly::Array Readonly::Hash }
    );

#----------------------------------------------------------------------------

sub supported_parameters {
    return (
        {
            name           => 'allowed_values',
            description    => 'Individual and ranges of values to allow, and/or "all_integers".',
            default_string => '0 1 2',
            parser         => \&_parse_allowed_values,
        },
        {
            name               => 'allowed_types',
            description        => 'Kind of literals to allow.',
            default_string     => 'Float',
            behavior           => 'enumeration',
            enumeration_values => [ qw{ Binary Exp Float Hex Octal } ],
            enumeration_allow_multiple_values => 1,
        },
    );
}

sub default_severity { return $SEVERITY_LOW          }
sub default_themes   { return qw( core maintenance ) }
sub applies_to       { return 'PPI::Token::Number'   }

#----------------------------------------------------------------------------

sub initialize_if_enabled {
    my ($self, $config) = @_;

    $self->_determine_checked_types();

    return $TRUE;
}

sub _parse_allowed_values {
    my ($self, $parameter, $config_string) = @_;

    my ( $all_integers_allowed, $allowed_values )
        = _determine_allowed_values($config_string);

    my $allowed_string = ' is not one of the allowed literal values (';
    if ($all_integers_allowed) {
        $allowed_string .= 'all integers';

        if ( %{$allowed_values} ) {
            $allowed_string .= ', ';
        }
    }
    $allowed_string
        .= ( join ', ', sort { $a <=> $b } keys %{$allowed_values} ) . ').'
        . $USE_READONLY_OR_CONSTANT;

    $self->{_allowed_values}       = $allowed_values;
    $self->{_all_integers_allowed} = $all_integers_allowed;
    $self->{_allowed_string}       = $allowed_string;

    return;
}

sub _determine_allowed_values {
    my $config_string = shift;

    my @allowed_values;
    my @potential_allowed_values;
    my $all_integers_allowed = 0;

    if ( defined $config_string ) {
        my @allowed_values_strings =
            grep {$_} split m/\s+/xms, $config_string;

        foreach my $value_string (@allowed_values_strings) {
            if ($value_string eq 'all_integers') {
                $all_integers_allowed = 1;
            } elsif ( $value_string =~ m/ \A $SIGNED_NUMBER \z /xms ) {
                push @potential_allowed_values, $value_string + 0;
            } elsif ( $value_string =~ m/$RANGE/xms ) {
                my ( $minimum, $maximum, $increment ) = ($1, $2, $3);
                $increment ||= 1;

                $minimum += 0;
                $maximum += 0;
                $increment += 0;

                for (                       ## no critic (ProhibitCStyleForLoops)
                    my $value = $minimum;
                    $value <= $maximum;
                    $value += $increment
                ) {
                    push @potential_allowed_values, $value;
                }
            } else {
                die q{Invalid value for allowed_values: }, $value_string,
                    q{. Must be a number, a number range, or},
                    qq{ "all_integers".\n};
            }
        }

        if ($all_integers_allowed) {
            @allowed_values = grep { $_ != int $_ } @potential_allowed_values;
        } else {
            @allowed_values = @potential_allowed_values;
        }
    } else {
        @allowed_values = (2);
    }

    if ( not $all_integers_allowed ) {
        push @allowed_values, 0, 1;
    }
    my %allowed_values = hashify(@allowed_values);

    return ( $all_integers_allowed, \%allowed_values );
}

sub _determine_checked_types {
    my $self = shift;

    my %checked_types = (
        'PPI::Token::Number::Binary'  => 'Binary literals (',
        'PPI::Token::Number::Float'   => 'Floating-point literals (',
        'PPI::Token::Number::Exp'     => 'Exponential literals (',
        'PPI::Token::Number::Hex'     => 'Hexadecimal literals (',
        'PPI::Token::Number::Octal'   => 'Octal literals (',
        'PPI::Token::Number::Version' => 'Version literals (',
    );

    # This will be set by the enumeration behavior specified in
    # supported_parameters() above.
    my $allowed_types = $self->{_allowed_types};

    foreach my $allowed_type ( keys %{$allowed_types} ) {
        delete $checked_types{"PPI::Token::Number::$allowed_type"};

        if ( $allowed_type eq 'Exp' ) {

            # because an Exp isa(Float).
            delete $checked_types{'PPI::Token::Number::Float'};
        }
    }

    $self->{_checked_types} = \%checked_types;

    return;
}


sub violates {
    my ( $self, $elem, undef ) = @_;

    return if PPI->VERSION le '1.118';

    return if _element_is_in_an_include_readonly_or_version_statement($elem);

    my $literal = $elem->literal();
    if (
            defined $literal
        and not (
                    $self->{_all_integers_allowed}
                and int $literal == $literal
            )
        and not defined $self->{_allowed_values}{$literal}
        and not (
                    _element_is_sole_component_of_a_subscript($elem)
                and $literal == $SPECIAL_ARRAY_SUBSCRIPT_EXEMPTION
            )
    ) {
        return
            $self->violation(
                $elem->content() . $self->{_allowed_string},
                $EXPL,
                $elem,
            );
    }


    my ( $number_type, $type_string );

    while (
        ( $number_type, $type_string ) = ( each %{ $self->{_checked_types} } )
    ) {
        if ( $elem->isa($number_type) ) {
            return
                $self->violation(
                    $type_string . $elem->content() . $TYPE_NOT_ALLOWED_SUFFIX,
                    $EXPL,
                    $elem,
                );
        }
    }

    return;
}

sub _element_is_sole_component_of_a_subscript {
    my $elem = shift;

    my $parent = $elem->parent();
    if ( $parent and $parent->isa('PPI::Statement::Expression') ) {
        if ( $parent->schildren() > 1 ) {
            return 0;
        }

        my $grandparent = $parent->parent();
        if (
                $grandparent
            and $grandparent->isa('PPI::Structure::Subscript')
        ) {
            return 1;
        }
    }

    return 0;
}

sub _element_is_in_an_include_readonly_or_version_statement {
    my $elem = shift;

    my $parent = $elem->parent();
    while ($parent) {
        if ( $parent->isa('PPI::Statement') ) {
            return 1 if $parent->isa('PPI::Statement::Include');

            if ( $parent->isa('PPI::Statement::Variable') ) {
                if ( $parent->type() eq 'our' ) {
                    my @variables = $parent->variables();
                    if (
                            scalar @variables == 1
                        and $variables[0] eq '$VERSION' ##no critic (RequireInterpolationOfMetachars)
                    ) {
                        return 1;
                    }
                }

                return 0;
            }

            my $first_token = $parent->first_token();
            if ( $first_token->isa('PPI::Token::Word') ) {
                if ( exists $READONLY_SUBROUTINES{$first_token} ) {
                    return 1;
                }
            }

            # Uncomment once PPI bug fixed.
            #        } elsif ($parent->isa('PPI::Structure::Block')) {
            #            return 0;
        }

        $parent = $parent->parent();
    }

    return 0;
}

1;

__END__

#----------------------------------------------------------------------------

=pod

=for stopwords

=head1 NAME

Perl::Critic::Policy::ValuesAndExpressions::ProhibitMagicNumbers


=head1 DESCRIPTION

What is a "magic number"?  A magic number is a number that appears in
code without any explanation; e.g.  C<$bank_account_balance *=
57.492;>.  You look at that number and have to wonder where that
number came from.  Since you don't understand the significance of the
number, you don't understand the code.

In general, numeric literals other than C<0> or C<1> in should not be
used.  Use the L<constant> pragma or the L<Readonly> module to give a
descriptive name to the number.

There are, of course, exceptions to when this rule should be applied.
One good example is positioning of objects in some container like
shapes on a blueprint or widgets in a user interface.  In these cases,
the significance of a number can readily be determined by context.


=head2 Ways in which this module applies this rule.

By default, this rule is relaxed in that C<2> is permitted to allow
for common things like alternation, the STDERR file handle, etc..

Numeric literals are allowed in C<use> and C<require> statements to
allow for things like Perl version restrictions and L<Test::More>
plans.  Declarations of C<$VERSION> package variables are permitted.
Use of C<Readonly>, C<Readonly::Scalar>, C<Readonly::Array>, and
C<Readonly::Hash> from the L<Readonly> module are obviously valid, but
use of C<Readonly::Scalar1>, C<Readonly::Array1>, and
C<Readonly::Hash1> are specifically not supported.

Use of binary, exponential, hexadecimal, octal, and version numbers,
even for C<0> and C<1>, outside of C<use>/C<require>/C<Readonly>
statements aren't permitted (but you can change this).

There is a special exemption for accessing the last element of an
array, i.e. C<$x[-1]>.


  $x = 0;                                   #ok
  $x = 0.0;                                 #ok
  $x = 1;                                   #ok
  $x = 1.0;                                 #ok
  $x = 1.5;                                 #not ok
  $x = 0b0                                  #not ok
  $x = 0b1                                  #not ok
  $x = 0x00                                 #not ok
  $x = 0x01                                 #not ok
  $x = 000                                  #not ok
  $x = 001                                  #not ok
  $x = 0e1                                  #not ok
  $x = 1e1                                  #not ok

  $frobnication_factor = 42;                #not ok
  use constant FROBNICATION_FACTOR => 42;   #ok


  use 5.6.1;                                #ok
  use Test::More plan => 57;                #ok
  our $VERSION = 0.22;                      #ok


  $x = $y[-1]                               #ok
  $x = $y[-2]                               #not ok



  foreach my $solid (1..5) {                #not ok
      ...
  }


  use Readonly;

  Readonly my $REGULAR_GEOMETRIC_SOLIDS => 5;

  foreach my $solid (1..$REGULAR_GEOMETRIC_SOLIDS) {  #ok
      ...
  }


=head1 CONFIGURATION

This policy has two options: C<allowed_values> and C<allowed_types>.


=head2 C<allowed_values>

The C<allowed_values> parameter is a whitespace delimited set of
permitted number I<values>; this does not affect the permitted formats
for numbers.  The defaults are equivalent to having the following in
your F<.perlcriticrc>:

  [ValuesAndExpressions::ProhibitMagicNumbers]
  allowed_values = 0 1 2

Note that this policy forces the values C<0> and C<1> into the
permitted values.  Thus, specifying no values,

  allowed_values =

is the same as simply listing C<0> and C<1>:

  allowed_values = 0 1

The special C<all_integers> value, not surprisingly, allows all
integral values to pass, subject to the restrictions on number types.

Ranges can be specified as two (possibly fractional) numbers separated
by two periods, optionally suffixed with an increment using the Perl 6
C<:by()> syntax.  E.g.

  allowed_values = 7..10

will allow 0, 1, 7, 8, 9, and 10 as literal values.  Using fractional
values like so

  allowed_values = -3.5..-0.5:by(0.5)

will permit -3.5, -3, -2.5, -2, -2.5, -1, -0.5, 0, and 1.
Unsurprisingly, the increment defaults to 1, which means that

  allowed_values = -3.5..-0.5

will make -3.5, -2.5, -2.5, -0.5, 0, and 1 valid.

Ranges are not lazy, i.e. you'd better have a lot of memory available
if you use a range of C<1..1000:by(0.01)>.  Also remember that all of
this is done using floating-point math, which means that
C<1..10:by(0.3333)> is probably not going to be very useful.

Specifying an upper limit that is less than the lower limit will
result in no values being produced by that range.  Negative increments
are not permitted.

Multiple ranges are permitted.

To put this all together, the following is a valid, though not likely
to be used, F<.perlcriticrc> entry:

  [ValuesAndExpressions::ProhibitMagicNumbers]
  allowed_values = 3.1415269 82..103 -507.4..57.8:by(0.2) all_integers


=head2 C<allowed_types>

The C<allowed_types> parameter is a whitespace delimited set of
subclasses of L<PPI::Token::Number>.

Decimal integers are always allowed.  By default, floating-point
numbers are also allowed.

For example, to allow hexadecimal literals, you could configure this
policy like

  [ValuesAndExpressions::ProhibitMagicNumbers]
  allowed_types = Hex

but without specifying anything for C<allowed_values>, the allowed
hexadecimal literals will be C<0x00>, C<0x01>, and C<0x02>.  Note,
also, as soon as you specify a value for this parameter, you must
include C<Float> in the list to continue to be able to use floating
point literals.  This effect can be used to restrict literals to only
decimal integers:

  [ValuesAndExpressions::ProhibitMagicNumbers]
  allowed_types =

If you permit exponential notation, you automatically also allow
floating point values because an exponential is a subclass of
floating-point in L<PPI>.


=head1 BUGS

There is currently no way to permit version numbers in regular code,
even if you include them in the allowed_types.  Some may actually
consider this a feature.


=head1 AUTHOR

Elliot Shank C<< <perl@galumph.com> >>


=head1 COPYRIGHT

Copyright (c) 2006-2008 Elliot Shank.  All rights reserved.

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.  The full text of this license
can be found in the LICENSE file included with this module.

=cut

# Local Variables:
#   mode: cperl
#   cperl-indent-level: 4
#   fill-column: 78
#   indent-tabs-mode: nil
#   c-indentation-style: bsd
# End:
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab :