Perl-Critic

 view release on metacpan or  search on metacpan

lib/Perl/Critic/Annotation.pm  view on Meta::CPAN

    #
    #############################################################################

    my @disabled_policy_names;
    if ( my ($patterns_string) = $annotation_element =~ $no_critic ) {

        # Compose the specified modules into a regex alternation.  Wrap each
        # in a no-capturing group to permit "|" in the modules specification.

        my @policy_name_patterns = grep { $_ ne $EMPTY }
            split m{\s *[,\s] \s*}xms, $patterns_string;
        my $re = join $PIPE, map {"(?:$_)"} @policy_name_patterns;
        my @site_policy_names = Perl::Critic::PolicyFactory::site_policy_names();
        @disabled_policy_names = grep {m/$re/ixms} @site_policy_names;

        # It is possible that the Policy patterns listed in the annotation do not
        # match any of the site policy names.  This could happen when running
        # on a machine that does not have the same set of Policies as the author.
        # So we must return something here, otherwise all Policies will be
        # disabled.  We probably need to add a mechanism to (optionally) warn
        # about this, just to help the author avoid writing invalid Policy names.

lib/Perl/Critic/Policy/BuiltinFunctions/ProhibitStringySplit.pm  view on Meta::CPAN

=head1 DESCRIPTION

The C<split> function always interprets the PATTERN argument as a
regular expression, even if you specify it as a string.  This causes
much confusion if the string contains regex metacharacters.  So for
clarity, always express the PATTERN argument as a regex.

    $string = 'Fred|Barney';
    @names = split '|', $string; #not ok, is ('F', 'r', 'e', 'd', '|', 'B', 'a' ...)
    @names = split m/[|]/, $string; #ok, is ('Fred', Barney')

When the PATTERN is a single space the C<split> function has special
behavior, so Perl::Critic forgives that usage.  See C<"perldoc -f
split"> for more information.


=head1 CONFIGURATION

This Policy is not configurable except for the standard options.

lib/Perl/Critic/Policy/Documentation/RequirePodSections.pm  view on Meta::CPAN

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

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

sub _parse_sections {
    my $config_string = shift;

    my @sections = split m{ \s* [|] \s* }xms, $config_string;

    return map { uc } @sections;  # Normalize CaSe!
}

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

    if ( defined $config_string ) {
        $self->{_lib_sections} = [ _parse_sections( $config_string ) ];
    }

lib/Perl/Critic/Policy/Modules/RequireFilenameMatchesPackage.pm  view on Meta::CPAN

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

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

    # 'Foo::Bar' -> ('Foo', 'Bar')
    my $pkg_node = $doc->find_first('PPI::Statement::Package');
    return if not $pkg_node;
    my $pkg = $pkg_node->namespace();
    return if $pkg eq 'main';
    my @pkg_parts = split m/(?:\'|::)/xms, $pkg;


    # 'lib/Foo/Bar.pm' -> ('lib', 'Foo', 'Bar')
    my $filename = $pkg_node->logical_filename() || $doc->filename();
    return if not $filename;

    my @path = File::Spec->splitpath($filename);
    $filename = $path[2];
    $filename =~ s/ [.] \w+ \z //xms;
    my @path_parts =

lib/Perl/Critic/Policy/NamingConventions/Capitalization.pm  view on Meta::CPAN

    return $self->_check_capitalization(
        symbol_without_sigil($name), $name, 'constant', $elem,
    );
}

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

    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;

lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitMagicNumbers.pm  view on Meta::CPAN

sub _determine_allowed_values {
    my ($config_string) = @_;

    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;

lib/Perl/Critic/PolicyFactory.pm  view on Meta::CPAN

#-----------------------------------------------------------------------------
# Some static helper subs

sub _modules_from_blib {
    my (@modules) = @_;
    return grep { _was_loaded_from_blib( _module2path($_) ) } @modules;
}

sub _module2path {
    my $module = shift || return;
    return File::Spec::Unix->catdir(split m/::/xms, $module) . '.pm';
}

sub _was_loaded_from_blib {
    my $path = shift || return;
    my $full_path = $INC{$path};
    return $full_path && $full_path =~ m/ (?: \A | \b b ) lib \b /xms;
}

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

lib/Perl/Critic/TestUtils.pm  view on Meta::CPAN

        }
    }

    return $subtest;
}

sub bundled_policy_names {
    require ExtUtils::Manifest;
    my $manifest = ExtUtils::Manifest::maniread();
    my @policy_paths = map {m{\A lib/(Perl/Critic/Policy/.*).pm \z}xms} keys %{$manifest};
    my @policies = map { join q{::}, split m{/}xms } @policy_paths;
    my @sorted_policies = sort @policies;
    return @sorted_policies;
}

sub names_of_policies_willing_to_work {
    my %configuration = @_;

    my @policies_willing_to_work =
        Perl::Critic::Config
            ->new( %configuration )

lib/Test/Perl/Critic/Policy.pm  view on Meta::CPAN

    # If any optional modules are NOT available, then there should be no violations.
    return 0 if not _all_optional_modules_are_available($subtest);
    return $subtest->{failures};
}

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

sub _all_optional_modules_are_available {
    my ($subtest) = @_;
    my $optional_modules = $subtest->{optional_modules} or return 1;
    return all {eval "require $_;" or 0;} split m/,\s*/xms, $optional_modules;
}

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

sub _create_test_name {
    my ($policy, $subtest) = @_;
    return join ' - ', $policy, "line $subtest->{lineno}", $subtest->{name};
}

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

t/12_policy_listing.t  view on Meta::CPAN

my $policy_count = scalar @policies;

plan( tests => $policy_count + 1);

#-----------------------------------------------------------------------------
# These tests verify that the listing has the right number of lines (one per
# policy) and that each line matches the expected pattern.  This indirectly
# verifies that each core policy declares at least one theme.

my $listing_as_string = "$listing";
my @listing_lines = split m/ \n /xms, $listing_as_string;
my $line_count = scalar @listing_lines;
is( $line_count, $policy_count, qq{Listing has all $policy_count policies} );


my $listing_pattern = qr< \A \d [ ] [\w:]+ [ ] \[ [\w\s]+ \] \z >xms;
for my $line ( @listing_lines ) {
    like($line, $listing_pattern, 'Listing format matches expected pattern');
}

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

t/20_policy_require_consistent_newlines.t  view on Meta::CPAN

__END__
end_body
__DATA__
DataLine1
DataLine2
END_PERL

is( fcritique($policy, \$base_code), 0, $policy );

my @lines = split m/\n/xms, $base_code;
for my $keyword (qw<
    Pkg; heredoc_body HEREDOC POD_HEADER pod =cut
    comment_line inline_comment
    __END__ end_body __DATA__ DataLine1 DataLine2
>) {
    my $is_first_line = $lines[0] =~ m/\Q$keyword\E\z/xms;
    my $nfail = $is_first_line ? @lines-1 : 1;
    for my $nl (
        "\N{LINE FEED}",
        "\N{CARRIAGE RETURN}",

t/ValuesAndExpressions/RequireInterpolationOfMetachars.run  view on Meta::CPAN

## name Do complain about RCS variables, if not turned on.
## failures 7
## cut

$VERSION = q<$Revision$>;
($VERSION) = q<$Revision$> =~ m/(\d+)/mx;
our $VERSION = substr(q/$Revision$/, 10);
our ($VERSION) = q<$Revision$> =~ m/(\d+)/mx;
our ($VERSION) = (q<$Revision$> =~ m/(\d+)/mx);
our (undef, $AUTHOR, undef, undef, $VERSION) = split m/\s+/, q<$Author$ $Revision$>;

# Yes, silly example, but still need to check it.
if ( ($VERSION) = q<$Revision$> =~ m/(\d+)/mx ) {}

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

## name Don't complain about RCS variables, if turned on.
## failures 0
## parms { rcs_keywords => 'Revision Author' }
## cut

$VERSION = q<$Revision$>;
($VERSION) = q<$Revision$> =~ m/(\d+)/mx;
our $VERSION = substr(q/$Revision$/, 10);
our ($VERSION) = q<$Revision$> =~ m/(\d+)/mx;
our ($VERSION) = (q<$Revision$> =~ m/(\d+)/mx);
our (undef, $AUTHOR, undef, undef, $VERSION) = split m/\s+/, q<$Author$ $Revision$>;

# Yes, silly example, but still need to check it.
if ( ($VERSION) = q<$Revision$> =~ m/(\d+)/mx ) {}

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

## name Don't complain about '${}' and '@{}' because they're invalid syntax. See RT #38528/commit r3077 for original problem/solution.
## failures 0
## cut

t/Variables/RequireLocalizedPunctuationVars.run.PL  view on Meta::CPAN

@ARGV = (1, 2, 3);

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

## name Allow "my" as well, RT #33937
## failures 0
## cut

for my $entry (
   sort {
       my @a = split m{,}xms, $a;
       my @b = split m{,}xms, $b;
       $a[0] cmp $b[0] || $a[1] <=> $b[1]
   } qw( b,6 c,3 )
   )
{
   print;
}

#-----------------------------------------------------------------------------
# Local Variables:
#   mode: cperl