File Coverage

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

Criterion	Covered	Total	%
statement	60	64	93.7
branch	21	26	80.7
condition	12	30	40.0
subroutine	11	12	91.6
pod	4	4	100.0
total	108	136	79.4

package Module::Checkstyle::Check::Whitespace;

use strict;
use warnings;

use Carp qw(croak);
use Readonly;

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

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

# The directives we provide
Readonly my $AFTER_COMMA        => 'after-comma';
Readonly my $BEFORE_COMMA       => 'before-comma';
Readonly my $AFTER_FAT_COMMA    => 'after-fat-comma';
Readonly my $BEFORE_FAT_COMMA   => 'before-fat-comma';
Readonly my $AFTER_COMPOUND     => 'after-compound';

sub register {
    return (
            'PPI::Token::Operator'     => \&handle_operator,
            'PPI::Statement::Compound' => \&handle_compound,
        );
}

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

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

    # Keep configuration local
    foreach ($AFTER_COMMA, $BEFORE_COMMA, $AFTER_FAT_COMMA, $BEFORE_FAT_COMMA, $AFTER_COMPOUND) {
        $self->{$_} = as_true($config->get_directive($_));
    }

    return $self;
}

sub handle_operator {
    my ($self, $operator, $file) = @_;

    my @problems;

    push @problems, $self->_handle_comma($operator, $file);
    push @problems, $self->_handle_fat_comma($operator, $file);

    return @problems;
}

sub _handle_comma {
    my ($self, $operator, $file) = @_;

    my @problems;

    if ($operator->content() eq ',') {
        if ($self->{$AFTER_COMMA}) {
            # Next sibling should be whitespace
            my $sibling = $operator->next_sibling();
            if ($sibling && ref $sibling && !$sibling->isa('PPI::Token::Whitespace')) {
                push @problems, new_problem($self->config, $AFTER_COMMA,
                                             qq(Missing whitespace after comma (,)),
                                             $operator, $file);
            }
        }

        if ($self->{$BEFORE_COMMA}) {
            # Previous sibling should be whitespace
            my $sibling = $operator->previous_sibling();
            if ($sibling && ref $sibling && !$sibling->isa('PPI::Token::Whitespace')) {
                push @problems, new_problem($self->config, $BEFORE_COMMA,
                                             qq(Missing whitespace before comma (,)),
                                             $operator, $file);
            }
        }
    }

    return @problems;
}

sub _handle_fat_comma {
    my ($self, $operator, $file) = @_;

    my @problems;

    if ($operator->content() eq '=>') {
        if ($self->{$AFTER_FAT_COMMA}) {
            # Next sibling should be whitespace
            my $sibling = $operator->next_sibling();
            if ($sibling && ref $sibling && !$sibling->isa('PPI::Token::Whitespace')) {
                push @problems, new_problem($self->config, $AFTER_FAT_COMMA,
                                             qq(Missing whitespace after fat comma (=>)),
                                             $operator, $file);
            }
        }

        if ($self->{$BEFORE_FAT_COMMA}) {
            # Previous sibling should be whitespace
            my $sibling = $operator->previous_sibling();
            if ($sibling && ref $sibling && !$sibling->isa('PPI::Token::Whitespace')) {
                push @problems, new_problem($self->config, $BEFORE_FAT_COMMA,
                                             qq(Missing whitespace before fat comma (=>)),
                                             $operator, $file);
            }
        }
    }

    return @problems;
}

sub handle_compound {
    my ($self, $compound, $file) = @_;

    my @problems;

    if ($self->{$AFTER_COMPOUND}) {
        my @children = $compound->schildren();

      CHECK_COMPOUND_BLOCK:
        foreach my $child (@children) {
            next CHECK_COMPOUND_BLOCK if !$child->isa('PPI::Token::Word');
            my $word = $child->content();
            my $sibling = $child->next_sibling();
            if (defined $sibling && ref $sibling && !$sibling->isa('PPI::Token::Whitespace')) {
                push @problems, new_problem($self->config, $AFTER_COMPOUND,
                                             qq('$word' is not followed by whitespace),
                                             $child, $file);
            }
        }
    }

    return @problems;
}

1;
__END__