File Coverage

blib/lib/Module/Checkstyle/Check/Variable.pm

Criterion	Covered	Total	%
statement	49	50	98.0
branch	14	16	87.5
condition	12	15	80.0
subroutine	10	11	90.9
pod	3	3	100.0
total	88	95	92.6

package Module::Checkstyle::Check::Variable;

use strict;
use warnings;

use Carp qw(croak);
use Lingua::EN::Inflect::Number qw(number);
use Readonly;

use Module::Checkstyle::Util qw(:args :problem);

use base qw(Module::Checkstyle::Check);

# The directives we provide
Readonly my $MATCHES_NAME         => 'matches-name';
Readonly my $ARRAYS_IN_PLURAL     => 'arrays-in-plural';
Readonly my $HASHES_IN_SINGULAR   => 'hashes-in-singular';

sub register {
    return (
            'PPI::Statement::Variable' => \&handle_declaration,
        );
}

sub new {
    my ($class, $config) = @_;

    my $self = $class->SUPER::new($config);

    # Keep configuration local
    $self->{$MATCHES_NAME}       = as_regexp($config->get_directive($MATCHES_NAME));
    $self->{$ARRAYS_IN_PLURAL}   = as_true($config->get_directive($ARRAYS_IN_PLURAL));
    $self->{$HASHES_IN_SINGULAR} = as_true($config->get_directive($HASHES_IN_SINGULAR));

    return $self;
}

sub handle_declaration {
    my ($self, $declaration, $file) = @_;

    my @variables = $declaration->variables();
    return $self->_check_variables($declaration, $file, @variables);
}

sub _check_variables {
    my ($self, $declaration, $file, @variables) = @_;

    my @problems;

  CHECK_VARIABLE:
    foreach my $variable (@variables) {
        my $type = substr($variable, 0, 1);
        my $name = substr($variable, 1);

        # Ignore "built-in" arrays and hashes
        next CHECK_VARIABLE if $type eq '@' && $name =~ /^ISA|EXPORT|EXPORT_OK$/;
        next CHECK_VARIABLE if $type eq '%' && $name =~ /^EXPORT_TAGS$/;

        # matches-name
        if ($self->{$MATCHES_NAME}) {
            if ($name && $name !~ $self->{$MATCHES_NAME}) {
                push @problems, new_problem($self->config, $MATCHES_NAME,
                                             qq(Variable '$variable' does not match '$self->{$MATCHES_NAME}'),
                                             $declaration, $file);
            }
        }

        # arrays-in-plural
        if ($type eq '@' && $self->{$ARRAYS_IN_PLURAL}) {
            my ($last_word) = $name =~ /([A-Z]?(?:[a-z0-9]+|[A-Z0-9]+))$/;
            if (number(lc($last_word)) ne 'p') {
                push @problems, new_problem($self->config, $ARRAYS_IN_PLURAL,
                                             qq(Variable '$variable' is an array and must be named in plural),
                                             $declaration, $file);
            }
        }

        # hashes-in-singular
        if ($type eq '%' && $self->{$HASHES_IN_SINGULAR}) {
            my ($last_word) = $name =~ /([A-Z]?(?:[a-z0-9]+|[A-Z0-9]+))$/;
            if (number(lc($last_word)) ne 's') {
                push @problems, new_problem($self->config, $HASHES_IN_SINGULAR,
                                             qq(Variable '$variable' is an hash and must be named in singular),
                                             $declaration, $file);
            }
        }
    }

    return @problems;
}

1;
__END__