File Coverage

blib/lib/Perl/Critic/Policy/logicLAB/RequirePackageNamePattern.pm

Criterion	Covered	Total	%
statement	66	74	89.1
branch	15	22	68.1
condition	4	11	36.3
subroutine	15	15	100.0
pod	4	4	100.0
total	104	126	82.5

package Perl::Critic::Policy::logicLAB::RequirePackageNamePattern;

# $Id: ProhibitShellDispatch.pm 8114 2013-07-25 12:57:04Z jonasbn $

use strict;
use warnings;
use 5.006;

use base 'Perl::Critic::Policy';
use Perl::Critic::Utils qw{ $SEVERITY_MEDIUM :booleans};
use Carp qw(carp);
use Data::Dumper;

our $VERSION = '0.03';

use constant supported_parameters => qw(names debug exempt_programs);
use constant default_severity     => $SEVERITY_MEDIUM;
use constant default_themes       => qw(logiclab);

sub prepare_to_scan_document {
    my ( $self, $document ) = @_;
    if ( $self->{exempt_programs} && $document->is_program() ) {
        return $FALSE;
    }

    return $document->is_module();
}

sub applies_to {
    return (
        qw(
            PPI::Statement::Package
            )
    );
}

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

    if ( not $self->{_names} ) {
        return;
    }

    my @children = $elem->children;

    if ( $children[0]->content eq 'package' ) {
        #TODO we might have to look for words here instead of using an array index
        #TODO and we should add exception in the case an actual package is not located
        my $package = $children[2]->content;

        if ($self->{debug}) {
            print STDERR "located package: $package\n";
        }

        my $no_of_patterns = scalar @{$self->{_names}};
        my $no_of_violations = 0;

        foreach my $name (@{$self->{_names}}) {
            #TODO investigate wht this is a regular expression and so are
            #actual evaluation in line 67, at least according to Perl::Critic
            #[RegularExpressions::RequireExtendedFormatting]
            my $regex = qr/$name/x;

            if ($self->{debug}) {
                print STDERR "Regex: $regex\n";
            }

            if ( $package !~ m/$regex/xs ) {
                if ($no_of_patterns > 1) {
                    $no_of_violations++;

                    if ($no_of_patterns == $no_of_violations) {
                        return $self->violation(
                            "Package name: $package is not complying with required standard",
                            "Use specified requirement for package naming for $package",
                            $elem
                        );
                    }

                } else {

                    return $self->violation(
                        "Package name: $package is not complying with required standard",
                        "Use specified requirement for package naming for $package",
                        $elem
                    );
                }
            }
        }

    } else {
        carp 'Unable to locate package keyword';
    }

    return;
}

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

    #debug - order is significant, since we might need debugging
    $self->{debug} = $config->get('debug') || $FALSE;

    #Names:
    #fetching configured names
    my $names = $config->get('names');

    if ($self->{debug}) {
        warn "Requirements for package names are: $names\n";
    }

    #parsing configured names, see also _parse_names
    if ($names) {
        $self->{_names} = $self->_parse_names($names) || q{};
    }

    #exempt_programs
    $self->{exempt_programs} = $config->get('exempt_programs') || $TRUE;

    return $TRUE;
}

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

    my @names = split /\s*\|\|\s*/x, $config_string;

    if ($self->{debug}) {
        print STDERR "our split line:\n";
        print STDERR Dumper \@names;
    }

    return \@names;
}

1;

__END__

=pod

=head1 NAME

Perl::Critic::Policy::logicLAB::RequirePackageNamePattern - simple policy for enforcing a package naming policy

=head1 AFFILIATION

This policy is a policy in the Perl::Critic::logicLAB distribution. The policy
is themed: logiclab.

=head1 VERSION

This documentation describes version 0.03.

=head1 DESCRIPTION

The policy can be used to enforced naming conventions for packages.

=head1 SYNOPSIS

Policy configuration:

    [logicLAB::RequirePackageNamePattern]
    names = Acme

Your package:

    package This::Is::A::Test;

        # code goes here

    1;

Invocation of policy:

    $ perlcritic --single-policy logicLAB::RequirePackageNamePattern lib

Explanation:

    Use specified requirement for package naming for This::Is::A::Test

Description:

    Package name: This::Is::A::Test is not complying with required standard

=head1 CONFIGURATION AND ENVIRONMENT

This policy allow you to configure the contents of the shebang lines you
want to allow using L</names>.

=head2 names

C<names>, is the configuration parameter used to specify the patterns you
want to enforce.

The different usage scenarios are documented below

=head3 Toplevel namespace

    [logicLAB::RequirePackageNamePattern]
    names = ^App::

=head3 Subclass

    [logicLAB::RequirePackageNamePattern]
    names = ::JONASBN$

=head3 Postfix

    [logicLAB::RequirePackageNamePattern]
    names = Utils$

=head3 Prefix

    [logicLAB::RequirePackageNamePattern]
    names = ^Acme

=head3 Contains

    [logicLAB::RequirePackageNamePattern]
    names = Tiny

=head3 Or

    [logicLAB::RequirePackageNamePattern]
    names = Acme || logicLAB

=head2 debug

Optionally and for development purposes I have added a debug flag. This can be set in
your L<Perl::Critic> configuration file as follows:

    [logicLAB::RequirePackageNamePattern]
    debug = 1

This enables more explicit output on what is going on during the actual processing of
the policy.

=head1 DEPENDENCIES AND REQUIREMENTS

=over

=item * L<Module::Build>

=item * L<Perl::Critic>

=item * L<Perl::Critic::Utils>

=item * L<Perl::Critic::Policy>

=item * L<Test::More>

=item * L<Test::Class>

=item * L<Test::Perl::Critic>

=item * L<Data::Dumper>

=back

=head1 INCOMPATIBILITIES

This distribution has no known incompatibilities.

=head1 BUGS AND LIMITATIONS

There are no known bugs or limitations

=head1 TEST AND QUALITY

The following policies have been disabled for this distribution

=over

=item * L<Perl::Critic::Policy::ValuesAndExpressions::ProhibitConstantPragma>

Constants are good, - see the link below.

=over

=item * L<https://logiclab.jira.com/wiki/display/OPEN/Perl-Critic-Policy-ValuesAndExpressions-ProhibitConstantPragma>

=back

=item * L<Perl::Critic::Policy::NamingConventions::Capitalization>

=back

See also F<t/perlcriticrc>

=head2 TEST COVERAGE

Coverage test executed the following way, the coverage report is based on the
version described in this documentation (see L</VERSION>).

    ./Build testcover

    ---------------------------- ------ ------ ------ ------ ------ ------ ------
    File                           stmt   bran   cond    sub    pod   time  total
    ---------------------------- ------ ------ ------ ------ ------ ------ ------
    ...uirePackageNamePattern.pm   89.2   68.2   36.4  100.0  100.0  100.0   82.5
    Total                          89.2   68.2   36.4  100.0  100.0  100.0   82.5
    ---------------------------- ------ ------ ------ ------ ------ ------ ------

=head1 SEE ALSO

=over

=item * L<Perl::Critic>

=item * L<perlmod manpage|http://perldoc.perl.org/perlmod.html>

=item * L<http://logiclab.jira.com/wiki/display/PCPLRPNP/Home>

=item * L<http://logiclab.jira.com/wiki/display/PCLL/Home>

=back

=head1 AUTHOR

=over

=item * Jonas B. Nielsen, jonasbn C<< <[e-mail]> >>

=back

=head1 ACKNOWLEDGEMENT

=over

=item * Jeffrey Ryan Thalhammer (THALJEF) and the Perl::Critic contributors for
Perl::Critic

=back

=head1 LICENSE AND COPYRIGHT

Copyright (c) 2013-2014 Jonas B. Nielsen, jonasbn. All rights reserved.

Perl::Critic::Policy::logicLAB::RequirePackageNamePattern;  is released under
the Artistic License 2.0

The distribution is licensed under the Artistic License 2.0, as specified by
the license file included in this distribution.

=cut