view release on metacpan or  search on metacpan

share/PerlCritic/Critic/Policy/NamingConventions/Capitalization.pm  view on Meta::CPAN

    my $namespace = $elem->namespace();
    my @components = split m/::/xms, $namespace;

    foreach my $component (@components) {
        my $violation =
            $self->_check_capitalization(
                $component, $namespace, 'package', $elem,
            );
        return $violation if $violation;
    }

    return;
}

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

    my $type;
    my $symbol;
    my $second_element = $elem->schild(1);
    return if not $second_element;

    if ($second_element->isa('PPI::Token::Word')) {
        $type = $second_element->content();
        $symbol = $second_element->snext_sibling();
    } else {
        $type = 'my';
        $symbol = $second_element;
    }

    return if not $symbol;
    return if not $symbol->isa('PPI::Token::Symbol');

    my $name = $symbol->symbol();

    if ($type eq 'local') {
        # Fully qualified names are exempt because we can't be responsible
        # for other people's sybols.
        return if $name =~ m/$PACKAGE_REGEX/xms;
        return if is_perl_global($name);

        return $self->_check_capitalization(
            symbol_without_sigil($name), $name, 'global_variable', $elem,
        );
    }
    elsif ($type eq 'our') {
        return $self->_check_capitalization(
            symbol_without_sigil($name), $name, 'global_variable', $elem,
        );
    }

    # Got my or state: treat as local lexical variable
    return $self->_check_capitalization(
        symbol_without_sigil($name), $name, 'local_lexical_variable', $elem,
    );
}

sub _label_capitalization {
    my ($self, $elem, $name) = @_;

    return if _is_not_real_label($elem);
    ( my $label = $elem->content() ) =~ s< \s* : \z ><>xms;
    return $self->_check_capitalization($label, $label, 'label', $elem);
}

sub _check_capitalization {
    my ($self, $to_match, $full_name, $name_type, $elem) = @_;

    my $test = $self->{"_${name_type}_test"};
    if ( my $message = $test->($to_match) ) {
        return $self->violation(
            qq<$NAME_FOR_TYPE{$name_type} "$full_name" $message>,
            $EXPL,
            $elem,
        );
    }

    return;
}


# { my $x } parses as
#       PPI::Document
#           PPI::Statement::Compound
#               PPI::Structure::Block   { ... }
#                   PPI::Statement::Variable
#                       PPI::Token::Word        'my'
#                       PPI::Token::Symbol      '$x'
#                       PPI::Token::Structure   ';'
#
# Also, type() on the PPI::Statement::Compound returns "continue".  *sigh*
#
# The parameter is expected to be the PPI::Statement::Variable.
sub _is_directly_in_scope_block {
    my ($elem) = @_;


    return if is_in_subroutine($elem);

    my $parent = $elem->parent();
    return if not $parent->isa('PPI::Structure::Block');

    my $grand_parent = $parent->parent();
    return $TRUE if not $grand_parent;
    return $TRUE if $grand_parent->isa('PPI::Document');

    return if not $grand_parent->isa('PPI::Statement::Compound');

    my $type = $grand_parent->type();
    return if not $type;
    return if $type ne 'continue';

    my $great_grand_parent = $grand_parent->parent();
    return if
        $great_grand_parent and not $great_grand_parent->isa('PPI::Document');

    # Make sure we aren't really in a continue block.
    my $prior_to_grand_parent = $grand_parent->sprevious_sibling();
    return $TRUE if not $prior_to_grand_parent;
    return $TRUE if not $prior_to_grand_parent->isa('PPI::Token::Word');
    return $prior_to_grand_parent->content() ne 'continue';
}

sub _is_not_real_label {
    my $elem = shift;

    # PPI misparses part of a ternary expression as a label
    # when the token to the left of the ":" is a bareword.
    # See http://rt.cpan.org/Ticket/Display.html?id=41170
    # For example...
    #
    # $foo = $condition ? undef : 1;
    #
    # PPI thinks that "undef" is a label.  To workaround this,
    # I'm going to check that whatever PPI thinks is the label,
    # actually is the first token in the statement.  I believe
    # this should be true for all real labels.

    my $stmnt = $elem->statement() || return;
    my $first_child = $stmnt->schild(0) || return;
    return $first_child ne $elem;
}

1;

__END__

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

=pod

=for stopwords pbp perlstyle Schwern THINGY

=head1 NAME

Perl::Critic::Policy::NamingConventions::Capitalization - Distinguish different program components by case.


=head1 AFFILIATION

This Policy is part of the core L<Perl::Critic|Perl::Critic> distribution.


=head1 DESCRIPTION

Conway recommends to distinguish different program components by case.

Normal subroutines, methods and variables are all in lower case.

    my $foo;            # ok
    my $foo_bar;        # ok
    sub foo {}          # ok
    sub foo_bar {}      # ok

    my $Foo;            # not ok
    my $foo_Bar;        # not ok
    sub Foo     {}      # not ok
    sub foo_Bar {}      # not ok

Package and class names are capitalized.

    package IO::Thing;     # ok
    package Web::FooBar    # ok