ProhibitDuplicateSub.run000644001751001751 223414425173124 24641 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19/t/TooMuchCode## name simple. case 1. ## failures 1 ## cut sub inc { $_[0] + 1 } sub dec { $_[0] - 1 } sub inc { 1 + $_[0] } ## name simple. case 2. ## failures 0 ## cut sub inc { $_[0] + 1 } sub dec { $_[0] - 1 } ## name Multiple packages in the same Doc without duplicated sub case 1. ## failures 0 ## cut package Here; sub inc { $_[0] + 1 } package There; sub inc { 1 + $_[0] } ## name Multiple packages in the same Doc without duplicated sub. case 2. ## failures 0 ## cut package Here { sub inc { $_[0] + 1 } }; package There { sub inc { 1 + $_[0] } }; ## TODO Multiple packages in the same Doc with duplicated sub case 1. ## failures 1 ## cut package Here; sub inc { $_[0] + 1 } sub dec { $_[0] - 1 } sub inc { 1 + $_[0] } package There; sub inc { 1 + $_[0] } ## TODO Multiple packages in the same Doc with duplicated sub. case 2. ## failures 1 ## cut package Here { sub inc { $_[0] + 1 } sub dec { $_[0] - 1 } sub inc { 1 + $_[0] } }; package There { sub inc { 1 + $_[0] } }; ## name Multiple BEGIN, UNITCHECK, CHECK, INIT or END blocks ## failures 0 ## cut BEGIN {} BEGIN {} UNITCHECK {} UNITCHECK {} CHECK {} CHECK {} INIT {} INIT {} END {} END {} .perlcriticrc000644001751001751 11514425173124 20054 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19color = 0 verbose = %f:%l:%c:[%p] %m.\n only = 1 include = RequireUseStrict ProhibitLargeBlock.run000644001751001751 124114425173124 24257 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19/t/TooMuchCode## name Small map block ## failures 0 ## cut map { print 42; print 42; print 42; print 42; [42,42,42,42,42,42]; } (1..100); ## name Large map block ## failures 1 ## cut map { print 42; print 42; print 42; print 42; print 42; print 42; print 42; print 42; print 42; print 42; print 42; print 42; } (1...100) ## name Large map block - higher limit ## failures 0 ## parms { block_statement_count_limit => 20 } ## cut map { print 42; print 42; print 42; print 42; print 42; print 42; print 42; print 42; print 42; print 42; print 42; print 42; } (1...100) TooMuchCode.pm000644001751001751 475514425173124 23020 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19/lib/Perl/Criticpackage Perl::Critic::TooMuchCode; use strict; our $VERSION='0.19'; ## Look for the signature of misparsed ternary operator. ## https://github.com/adamkennedy/PPI/issues/62 ## Once PPI is fixed, this workaround can be eliminated. sub __get_terop_usage { my ($used, $doc) = @_; for my $question_mark (@{ $doc->find( sub { $_[1]->isa('PPI::Token::Operator') && $_[1]->content eq '?' }) ||[]}) { my $el = $question_mark->snext_sibling; next unless $el->isa('PPI::Token::Label'); my $tok = $el->content; $tok =~ s/\s*:\z//; $used->{$tok}++; } } sub __get_symbol_usage { my ($usage, $doc) = @_; __get_terop_usage($usage, $doc); Perl::Critic::Policy::Variables::ProhibitUnusedVariables::_get_regexp_symbol_usage($usage, $doc); for my $e (@{ $doc->find('PPI::Token::Symbol') || [] }) { $usage->{ $e->symbol() }++; } for my $class (qw{ PPI::Token::Quote::Double PPI::Token::Quote::Interpolate PPI::Token::QuoteLike::Backtick PPI::Token::QuoteLike::Command PPI::Token::QuoteLike::Readline PPI::Token::HereDoc }) { for my $e (@{ $doc->find( $class ) || [] }) { my $str = PPIx::QuoteLike->new( $e ) or next; for my $var ( $str->variables() ) { $usage->{ $var }++; } } } # Gather usages in the exact form of: # our @EXPORT = qw( ... ); # our @EXPORT_OK = qw( ... ); for my $st (@{ $doc->find('PPI::Statement::Variable') || [] }) { next unless $st->schildren == 5; my @children = $st->schildren; next unless $children[0]->content() eq 'our' && ($children[1]->content() eq '@EXPORT' || $children[1]->content() eq '@EXPORT_OK') && $children[2]->content() eq '=' && $children[3]->isa('PPI::Token::QuoteLike::Words') && $children[4]->content() eq ';'; for my $w ($children[3]->literal) { $usage->{ $w }++; } } return; } 1; __END__ =head1 NAME Perl::Critic::TooMuchCode - perlcritic add-ons that generally check for dead code. =head1 DESCRIPTION This add-on for L is aiming for identifying trivial dead code. Either the ones that has no use, or the one that produce no effect. Having dead code floating around causes maintenance burden. Some might prefer not to generate them in the first place. =head1 AUTHOR Kang-min Liu =head1 LICENSE MIT =cut ProhibitExtraStricture.run000644001751001751 137714425173124 25254 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19/t/TooMuchCode## name simple case 1 ## failures 0 ## cut use strict; print 42; ## name simple case 2 ## failures 0 ## cut use Moose; print 42; ## name no stricture, but fine by me. ## failures 0 ## cut use Bleh; print 42; ## name strict and Moose, case 1 ## failures 1 ## cut use strict; use Moose; print 42; ## name strict and Moose, case 2 ## failures 1 ## cut use Moose; use strict; print 42; ## multiple strict pragmas, no idea and don't care (at the moment). ## failures 0 ## cut use strict; use Moose; use strict; print 42; ## name strict and Test2::V0 ## failures 1 ## cut use strict; use Test2::V0; ## name perl 5.10 and strict ## failures 0 ## cut use 5.010; use strict; print 42; ## name perl 5.11 and strict ## failures 1 ## cut use 5.011; use strict; print 42; large_block.t000644001751001751 141714425173124 20310 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19/t#!perl use strict; use warnings; use Perl::Critic; use Perl::Critic::Utils qw{ :severities }; use Test::More; use Data::Dumper; use constant POLICY => 'Perl::Critic::Policy::TooMuchCode::ProhibitLargeBlock'; { my $pc = Perl::Critic->new( -only => 1 ); $pc->add_policy( -policy => POLICY, -params => { block_statement_count_limit => 20 } ); my $code = q~ use strict; map { print 42; print 42; print 42; print 42; print 42; print 42; print 42; print 42; print 42; print 42; print 42; print 42; } (1...100) ~; my @violations = $pc->critique( \$code ); ok !@violations; } done_testing(); ProhibitDuplicateLiteral.pm000644001751001751 620514425173124 31177 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19/lib/Perl/Critic/Policy/TooMuchCodepackage Perl::Critic::Policy::TooMuchCode::ProhibitDuplicateLiteral; use strict; use warnings; use List::Util 1.33 qw(any); use Perl::Critic::Utils; use PPI; use parent 'Perl::Critic::Policy'; sub default_themes { return qw( bugs maintenance ) } sub applies_to { return 'PPI::Document' } sub supported_parameters { return ({ name => 'allowlist', description => 'A list of numbers or quoted strings that can be allowed to occur multiple times.', default_string => "0 1", behavior => 'string', parser => \&_parse_allowlist, }); } sub _parse_allowlist { my ($self, $param, $value) = @_; my $default = $param->get_default_string(); my %allowlist; for my $v (grep { defined } ($default, $value)) { my $parser = PPI::Document->new(\$v); for my $token (@{$parser->find('PPI::Token::Number') ||[]}) { $allowlist{ $token->content } = 1; } for my $token (@{$parser->find('PPI::Token::Quote') ||[]}) { $allowlist{ $token->string } = 1; } } $self->{_allowlist} = \%allowlist; return undef; } sub violates { my ($self, undef, $doc) = @_; my %firstSeen; my @violations; for my $el (@{ $doc->find('PPI::Token::Quote') ||[]}) { next if $el->can("interpolations") && $el->interpolations(); my $val = $el->string; next if $self->{"_allowlist"}{$val}; if ($firstSeen{"$val"}) { push @violations, $self->violation( "A duplicate literal: '$el->string'", "Another literal value in the same piece of code.", $el, ); } else { $firstSeen{"$val"} = $el->location; } } for my $el (@{ $doc->find('PPI::Token::Number') ||[]}) { my $val = $el->content; next if $self->{"_allowlist"}{$val}; if ($firstSeen{$val}) { push @violations, $self->violation( "A duplicate literal: $el->content", "Another literal value in the same piece of code.", $el, ); } else { $firstSeen{$val} = $el->location; } } return @violations; } 1; __END__ =head1 NAME TooMuchCode::ProhibitDuplicateLiteral - Don't repeat yourself with identical literals =head1 DESCRIPTION This policy checks if there are string/number literals with identical value in the same piece of perl code. Usually that's a small signal of repeating and perhaps a small chance of refactoring. =head1 CONFIGURATION Some strings/numbers may be allowed to have duplicates by listing them in the C parameter in the configs: [TooMuchCode::ProhibitDuplicateLiteral] allowlist = 'present' "forty two" 42 The values is a space-separated list of numbers or quoted string. The default values in the allowlist are: C<0 1>. These two numbers are always part of allowlist and cannot be removed. Please be aware that, a string literal and its numerical literal counterpart (C<1> vs C<"1">) are considered to be the same. Adding C<"42"> to the allowlist is the same as adding C<42>. =cut META.yml000644001751001751 461014425173124 16663 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19--- abstract: 'perlcritic add-ons that generally check for dead code.' author: - 'Kang-min Liu ' build_requires: Test2::V0: '0' configure_requires: Module::Build::Tiny: '0.039' dynamic_config: 0 generated_by: 'App::ModuleBuildTiny version 0.041, CPAN::Meta::Converter version 2.150010' license: mit meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Perl-Critic-TooMuchCode provides: Perl::Critic::Policy::TooMuchCode::ProhibitDuplicateLiteral: file: lib/Perl/Critic/Policy/TooMuchCode/ProhibitDuplicateLiteral.pm Perl::Critic::Policy::TooMuchCode::ProhibitDuplicateSub: file: lib/Perl/Critic/Policy/TooMuchCode/ProhibitDuplicateSub.pm Perl::Critic::Policy::TooMuchCode::ProhibitExcessiveColons: file: lib/Perl/Critic/Policy/TooMuchCode/ProhibitExcessiveColons.pm version: '0.01' Perl::Critic::Policy::TooMuchCode::ProhibitExtraStricture: file: lib/Perl/Critic/Policy/TooMuchCode/ProhibitExtraStricture.pm Perl::Critic::Policy::TooMuchCode::ProhibitLargeBlock: file: lib/Perl/Critic/Policy/TooMuchCode/ProhibitLargeBlock.pm Perl::Critic::Policy::TooMuchCode::ProhibitLargeTryBlock: file: lib/Perl/Critic/Policy/TooMuchCode/ProhibitLargeTryBlock.pm Perl::Critic::Policy::TooMuchCode::ProhibitUnnecessaryScalarKeyword: file: lib/Perl/Critic/Policy/TooMuchCode/ProhibitUnnecessaryScalarKeyword.pm Perl::Critic::Policy::TooMuchCode::ProhibitUnnecessaryUTF8Pragma: file: lib/Perl/Critic/Policy/TooMuchCode/ProhibitUnnecessaryUTF8Pragma.pm Perl::Critic::Policy::TooMuchCode::ProhibitUnusedConstant: file: lib/Perl/Critic/Policy/TooMuchCode/ProhibitUnusedConstant.pm Perl::Critic::Policy::TooMuchCode::ProhibitUnusedImport: file: lib/Perl/Critic/Policy/TooMuchCode/ProhibitUnusedImport.pm Perl::Critic::Policy::TooMuchCode::ProhibitUnusedInclude: file: lib/Perl/Critic/Policy/TooMuchCode/ProhibitUnusedInclude.pm Perl::Critic::TooMuchCode: file: lib/Perl/Critic/TooMuchCode.pm version: '0.19' requires: List::Util: '1.50' PPIx::QuoteLike: '0' PPIx::Utils: '0.002' Perl::Critic: '0' Scalar::Util: '1.50' version: '0.77' resources: bugtracker: https://github.com/gugod/Perl-Critic-TooMuchCode/issues repository: https://github.com/gugod/Perl-Critic-TooMuchCode.git version: '0.19' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' x_spdx_expression: MIT x_static_install: '1' ProhibitUnnecessaryUTF8Pragma.pm000644001751001751 347214425173124 32051 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19/lib/Perl/Critic/Policy/TooMuchCodepackage Perl::Critic::Policy::TooMuchCode::ProhibitUnnecessaryUTF8Pragma; # ABSTRACT: "use utf8" is probably not needed if all characters in the source code are in 7bit ASCII range. use strict; use warnings; use Perl::Critic::Utils; use parent 'Perl::Critic::Policy'; sub default_themes { return qw( bugs maintenance ) } sub applies_to { return 'PPI::Document' } #--------------------------------------------------------------------------- sub violates { my ( $self, $elem, $doc ) = @_; my $use_utf8_statements = $elem->find( sub { my $st = $_[1]; $st->isa('PPI::Statement::Include') && $st->schild(0) eq 'use' && $st->schild(1) eq 'utf8'; } ); return unless $use_utf8_statements; my $chars_outside_ascii_range = 0; for (my $tok = $elem->first_token; $tok; $tok = $tok->next_token) { next unless $tok->significant; my $src = $tok->content; utf8::decode($src); my @c = split /\s+/, $src; for (my $i = 0; $i < @c; $i++) { if (ord($c[$i]) > 127) { $chars_outside_ascii_range++; } } last if $chars_outside_ascii_range; } unless ($chars_outside_ascii_range) { return $self->violation( "'use utf8;' seems to be unnecessary", 'All characters in the source code are within ASCII range.', $use_utf8_statements->[0], ); } return; } 1; =encoding utf-8 =head1 NAME TooMuchCode::ProhibitUnusedImport -- Find 'use utf8' statement that produces (almost) no effect. =head1 DESCRIPTION The utf8 pragma is used to declare that the source code itself can be decoded by utf-8 encoding rule as a sequence of characters. What this means is that all the characters in the code are within the ASCII range. =cut ProhibitUnnecessaryScalarKeyword.pm000644001751001751 233014425173124 32735 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19/lib/Perl/Critic/Policy/TooMuchCodepackage Perl::Critic::Policy::TooMuchCode::ProhibitUnnecessaryScalarKeyword; use strict; use warnings; use Perl::Critic::Utils; use parent 'Perl::Critic::Policy'; sub default_themes { return qw(maintenance) } sub applies_to { return 'PPI::Token::Word' } sub violates { my ( $self, $elem, undef ) = @_; return unless $elem->content eq 'scalar'; my $e = $elem->snext_sibling; return unless $e && $e->isa('PPI::Token::Symbol') && $e->raw_type eq '@'; $e = $elem->sprevious_sibling; return unless $e && $e->isa('PPI::Token::Operator') && $e->content eq '='; $e = $e->sprevious_sibling; return unless $e && $e->isa('PPI::Token::Symbol') && $e->raw_type eq '$'; return $self->violation('Unnecessary scalar keyword', "Assigning an array to a scalar implies scalar context.", $elem); } 1; __END__ =head1 NAME TooMuchCode::ProhibitUnnecessaryScalarKeyword - Finds `scalar` in scalar context. =head1 DESCRIPTION This policy dictates that the use of `scalar` for in statement like this needs to be removed: my $n = scalar @items; If the left-hand side of assignment is a single scalar variable, then the assignment is in scalar context. There is no need to add C keyword. ignored-modules.t000644001751001751 116114425173124 21135 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19/t#!perl use strict; use Perl::Critic (); use Perl::Critic::Utils qw{ :severities }; use Test::More; use constant POLICY => 'Perl::Critic::Policy::TooMuchCode::ProhibitUnusedImport'; { my $pc = Perl::Critic->new( -only => 1 ); $pc->add_policy( -policy => POLICY, -params => { ignored_modules => 'Test::Thingy' }, ); my $code = q~ use strict; use Git::Sub qw( push ); use Test::Thingy qw( Some::Module ); git::push qw(--tags origin master); ~; my @violations = $pc->critique( \$code ); ok( !@violations, 'no violations' ); } done_testing(); ProhibitLargeTryBlock.run000644001751001751 57114425173124 24743 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19/t/TooMuchCode## name Small Try block ## failures 0 ## cut use Try::Tiny; try { print 42; print 42; print 42; print 42; } or print 42; ## name Try ## failures 1 ## cut use Try::Tiny; try { print 42; print 42; print 42; print 42; print 42; print 42; print 42; print 42; print 42; print 42; print 42; print 42; } or print 42; ProhibitLargeTryBlock.pm000644001751001751 253514425173124 30456 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19/lib/Perl/Critic/Policy/TooMuchCodepackage Perl::Critic::Policy::TooMuchCode::ProhibitLargeTryBlock; use strict; use warnings; use Perl::Critic::Utils; use parent 'Perl::Critic::Policy'; sub default_themes { return qw(maintenance) } sub applies_to { return 'PPI::Structure::Block' } sub violates { my ( $self, $elem, $doc ) = @_; my $limit = $self->{try_block_statement_count_limit} || 10; return unless $self->__use_try_tiny($doc); my @violations; my $word_before = $elem->sprevious_sibling; return unless $word_before && $word_before->isa('PPI::Token::Word') && $word_before->content eq 'try'; my $s = $elem->find('PPI::Statement') or return; my $statement_count = @$s; return unless $statement_count > $limit; return $self->violation('try block is too large', "The statement count in this block is ${statement_count}, larger then the limit of ${limit}", $elem); } sub __use_try_tiny { my ($self, $elem) = @_; my $includes = $elem->find('PPI::Statement::Include') or return 0; return 0 < grep { $_->module eq 'Try::Tiny' } @$includes; } 1; =encoding utf-8 =head1 NAME TooMuchCode::ProhibitLargeTryBlock -- Find oversized `try..catch` block. =head1 DESCRIPTION You may or may not consider it a bad idea to have a lot of code in a C block. If you do, this module can be used to catch the oversized try blocks. =cut ProhibitUnusedInclude.run000644001751001751 360314425173124 25025 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19/t/TooMuchCode## name perl version ## failures 0 ## cut use v5.18; print 42; ## name File::Spec ## failures 1 ## cut use File::Spec; print 42; ## name File::Which is used ## failures 0 ## cut use File::Which; my $prog = which('ls'); ## name File::Which is unused ## failures 1 ## cut use File::Which; my $prog = "/bin/ls"; ## TODO File::Which used in 'constant' ## failures 0 ## cut use File::Which; use constant PROG => which("ls"); print "ls is: " . PROg; ## name Try::Tiny ## failures 1 ## cut use Try::Tiny; print 42; ## name Try::Tiny + File::Spec ## failures 2 ## cut use Try::Tiny; use File::Spec; print 42; ## name -Try::Tiny +File::Spec ## failures 1 ## cut use Try::Tiny; use File::Spec; try { print 42; }; ## name -Try::Tiny -File::Spec ## failures 0 ## cut use Try::Tiny; use File::Spec; try { print File::Spec->catfile("answer" => 42); }; ## name +Try::Tiny -File::Spec ## failures 1 ## cut use Try::Tiny; use File::Spec; print File::Spec->catfile("answer" => 42); ## name +Try::Lite ## failures 1 ## cut use Try::Lite; print localtime(); ## name Generic: use Foobar -- but we do not know how to verify if it is used. ## failures 0 ## cut use Foobar; print 42; ## name Generic: use Something objectively. ## failures 0 ## cut use Foobar; use Something; Something->process( localtime() ); ## name Generic: use Something functionally. ## failures 0 ## cut use Foobar; use Something; Something::process( localtime() ); ## name Hijk (unused) ## failures 1 ## cut use Hijk; print something(); ## name Hijk::request ## failures 0 ## cut use Hijk; Hijk::request($req); ## name Moo ## failures 0 ## cut use Moo; has zzz => ( is => "rw" ); ## name self; ## failures 0 ## cut use self; sub fnord { print $self->darf; } ## name Generic: with imported symbols. ## failures 0 ## cut use Foo qw(bar); my $a = 42; bar($a); ## name Pragmatism ## failures 0 ## cut use Test::NoWarnings; print 42; ProhibitDuplicateSub.pm000644001751001751 454514425173124 30341 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19/lib/Perl/Critic/Policy/TooMuchCodepackage Perl::Critic::Policy::TooMuchCode::ProhibitDuplicateSub; use strict; use warnings; use Perl::Critic::Utils; use parent 'Perl::Critic::Policy'; sub default_themes { return qw( bugs maintenance ) } sub applies_to { return 'PPI::Document' } sub initialize_if_enabled { my ($self, $config) = @_; $self->{_allow_duplicates_for} = { BEGIN => 1, UNITCHECK => 1, CHECK => 1, INIT => 1, END => 1, }; return $TRUE; } sub violates { my ($self, undef, $doc) = @_; my $packages = $doc->find('PPI::Statement::Package') || []; if (@$packages > 1) { return (); } my $subdefs = $doc->find('PPI::Statement::Sub') or return; my %seen; my @duplicates; for my $sub (@$subdefs) { next if $sub->forward || (! $sub->name); next if $self->{_allow_duplicates_for}{$sub->name}; if (exists $seen{ $sub->name }) { push @duplicates, $seen{ $sub->name }; } $seen{ $sub->name } = $sub; } my @violations = map { my $last_sub = $seen{ $_->name }; $self->violation( "Duplicate subroutine definition. Redefined at line: " . $last_sub->line_number . ", column: " . $last_sub->column_number, "Another subroutine definition latter in the same scope with identical name masks this one.", $_, ); } @duplicates; return @violations; } 1; =encoding utf-8 =head1 NAME TooMuchCode::ProhibitDuplicateSub - When 2 subroutines are defined with the same name, report the first one. =head1 DESCRIPTION This policy checks if there are subroutine definitions with identical names under the same namespace. If they exists, all but the last one are marked as violation. perl runtime allows a named subroutine to be redefined in the same source file and the latest definition wins. In the event that this is done by developers, preferably unintentionally, perl runtime warns about a subroutine is redefined with the position is for the one that wins. This policy does the opposite. Although the last one is not marked as a violation, it's position is reported together. Making it easier for developer to locate the subroutine. Should the developer decide to programmatically remove the duplicates, simply go through all the violations and remove those statements. =cut Changes000644001751001751 636714425173124 16720 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.190.19 - Released at 2023-05-05T21:24:23+0900 - ProhibitDuplicateLiteral: Improve description by including the literal and excluding line and column numbers. - ProhibitDuplicateSub: Allow multiple BEGIN, UNITCHECK, CHECK, INIT and END code blocks - Some improvements of documentation. 0.18 - Released at 2021-09-29T08:43:04+0900 - ProhibitDuplicateLiteral: the parameter "whitelist" is renamed to "allowlist" - ProhibitDuplicateLiteral: the parameter "whitelist_number" is removed - ProhibitUnusedImport: Deal with the special form of assigning to @EXPORT and @EXPORT_OK. Github PR #29, issue #18 0.17 - Released at 2021-09-20T20:44:45+0900 - ProhibitDuplicateLiteral: add "whitelist" parameter - ProhibitDuplicateLiteral: The "whitelist_number" parameter is being deprecated -- please replace it with "whitelist" 0.16 - Released at 2021-08-31T08:48:07+0900 - ProhibitUnusedImport: Fix a case of false positive: Imported vars that are interpolated in strings should not be violations. Github Issue #19 - ProhibitExtraStricture: Match the list of strict-equivalent modules in Perl::Critic. Github PR #21 - ProhibitExtraStricture: Recognize the strictures implied by `use VERSION`. Github PR #23 0.15 - Released at 2021-03-15T08:11:11+0900 - New policy: ProhibitExtraStricture - ProhibitDuplicateSub: Avoid one case of false positive when there are multiple packages in the same file. See: Github PR #10. 0.14 - Released at 2020-10-29T09:26:59+0900 - ProhibitUnusedImport: Make %special_modules settable via an ignored_modules attribute. Github PR #17 - ProhibitUnusedImport: Allow for is_ and to_ prefixes with Moose type imports. Github PR #16 - ProhibitUnusedImport: Recognize subroutine references as used imports. Github PR #15 - ProhibitUnusedImport: Ignore a few modules for good. Github PR #12, #17. 0.13 - Released at 2019-12-16T10:07:08+0900 - New policy: ProhibitDuplicateLiteral 0.12 - Released at 2019-01-11T16:57:36+0900 - ProhibitLargeBlock: add config parameter `block_statement_count_limit` 0.11 - Released at 2018-12-18T09:53:25+0900 - ProhibitUnusedConstant: Workaround a PPI bug that misparses ternary op. 0.10 - Released at 2018-11-16T11:12:47+0900 - ProhibitUnusedImport: Workaround a PPI bug that misparses ternary op. 0.09 - Released at 2018-10-31T09:10:59+0900 - new Policy: ProhibitDuplicateSub 0.08 - Released at 2018-10-16T09:05:01+0900 - ProhibitUnusedImport: Ignore symbols with '+' prefix. - ProhibitUnusedInclude: now correctly detects a whole lot more modules. 0.07 - Released at 2018-08-31T06:32:35+0900 - ProhibitUnusedImport: fix a false positive case about reporting unused imported variables. 0.06 - Release at 2018-08-29T23:13:58+0900 - ProhibitUnusedImport: fix a case when it failed to extract the tokens in `qw()` 0.05 - ProhibitUnusedImport: ignore Getopt::Long for it has special argument spec. - ProhibitUnusedConstant: avoid a case of false positive. 0.04 - ProhibitUnusedImport: ignore all pragmas. - add: ProhibitExcessiveColons 0.03 - add: ProhibitLargeBlock - add: ProhibitLargeTryBlock 0.02 - minor 0.01 - The beginning, with some primitive but useful new policies. ProhibitUnusedImport.run000644001751001751 441014425173124 24711 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19/t/TooMuchCode## name vars pragma ## failures 0 ## cut use vars qw(%foo); print 42; ## name Data::Dumper; ## failures 1 ## cut use Data::Dumper qw; print 42; ## name Getopt::Long config ## failures 0 ## cut use Getopt::Long qw(:config bundling); print 42; ## name Read ## failures 0 ## cut use Encode qw( decode ); my $val = decode ("utf-16be", $val); ## name Bin ## failures 0 ## cut use FindBin qw( $RealBin ); my $prog = $RealBin . "/../foo.pl"; ## name used in ternary op ## failures 0 ## cut use Foo qw( FOO BAR BAZ ); my $fb = hoi () ? FOO : hai () ? BAR : hui () ? BAZ ; ## name Importer syntax. 1 ## failures 1 ## cut use Importer 'Foo' => qw( BAR ); print 42; ## name Importer syntax. 2 ## failures 2 ## cut use Importer 'Foo' => qw( BAR QUX ); print 42; ## todo Importer syntax. List of str ## failures 2 ## cut use Importer 'Foo' => ( 'BAR', 'QUX' ); print 42; ## todo General syntax. List of str ## failures 2 ## cut use Foo ('BAR', 'QUX'); print 42; ## name Exporter ## failures 0 ## cut use Exporter qw/import/; print 42; ## name Test::Requires ## failures 0 ## cut use Test::Requires qw/DBI/; print 42; ## name subroutine ref ## failures 0 ## cut use Encode qw( decode ); my $ref = \&decode; ## name $Bin. issue 19 ## failures 0 ## cut use FindBin qw( $Bin ); use lib "$Bin/../../../../"; my $bar; ## name $Bin. issue 19. ## failures 0 ## cut use FindBin qw( $Bin ); use lib $Bin . "/../../../../"; ## name $Bin in interpolated string in print. issue 19. ## failures 0 ## cut use FindBin qw( $Bin ); my $bar; print "Here it is: $Bin"; ## name re-exporting is a form of using. with @EXPORT_OK. github issue 18. ## failures 0 ## cut use Foo qw( foo $bar @baz ); our @EXPORT_OK = qw(foo $bar @baz); ## name re-exporting is a form of using. with @EXPORT. github issue 18. ## failures 0 ## cut use Foo qw( foo $bar @baz ); our @EXPORT = qw(foo $bar @baz); ## name re-exporting. with code sample from github issue 18. ## failures 0 ## cut use Mojo::JSON qw(decode_json encode_json); { our @EXPORT_OK = qw( decode_json encode_json ); } ## name other var assigments with symbols in their literal forms should not be counted as usage ## failures 3 ## cut use Foo qw(foo $bar @baz); my @foo = qw(foo $bar @baz); ProhibitLargeBlock.pm000644001751001751 274014425173124 27755 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19/lib/Perl/Critic/Policy/TooMuchCodepackage Perl::Critic::Policy::TooMuchCode::ProhibitLargeBlock; use strict; use warnings; use List::Util qw(first); use Perl::Critic::Utils; use parent 'Perl::Critic::Policy'; sub default_themes { return qw(maintenance) } sub applies_to { return 'PPI::Structure::Block' } sub violates { my ( $self, $elem, $doc ) = @_; my $limit = $self->{_config}->{block_statement_count_limit} || $self->{block_statement_count_limit} || 10; my $word_before = $elem->sprevious_sibling; return unless $word_before && $word_before->isa('PPI::Token::Word'); my ($block_keyword) = first { $_ eq $word_before->content } qw(map grep do); return unless $block_keyword; my $s = $elem->find('PPI::Statement') or return; my $statement_count = @$s; return unless $statement_count > $limit; return $self->violation('Oversize block', "The statement count in this ${block_keyword} block is ${statement_count}, larger than the limit of ${limit}", $elem); } 1; =encoding utf-8 =head1 NAME TooMuchCode::ProhibitLargeBlock -- Find oversized blocks =head1 DESCRIPTION This policy scan for large code blocks of the following type. map { ... }; grep { ... }; do { ... }; By default a large block is one with more than 10 statements. If you need another limit, you can set the parameter C. For example in the I<.perlcriticrc> file [TooMuchCode::ProhibitLargeBlock] block_statement_count_limit = 20 =cut MANIFEST000644001751001751 240014425173124 16536 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19.perlcriticrc Build.PL Changes LICENSE MANIFEST META.json META.yml README cpanfile lib/Perl/Critic/Policy/TooMuchCode/ProhibitDuplicateLiteral.pm lib/Perl/Critic/Policy/TooMuchCode/ProhibitDuplicateSub.pm lib/Perl/Critic/Policy/TooMuchCode/ProhibitExcessiveColons.pm lib/Perl/Critic/Policy/TooMuchCode/ProhibitExtraStricture.pm lib/Perl/Critic/Policy/TooMuchCode/ProhibitLargeBlock.pm lib/Perl/Critic/Policy/TooMuchCode/ProhibitLargeTryBlock.pm lib/Perl/Critic/Policy/TooMuchCode/ProhibitUnnecessaryScalarKeyword.pm lib/Perl/Critic/Policy/TooMuchCode/ProhibitUnnecessaryUTF8Pragma.pm lib/Perl/Critic/Policy/TooMuchCode/ProhibitUnusedConstant.pm lib/Perl/Critic/Policy/TooMuchCode/ProhibitUnusedImport.pm lib/Perl/Critic/Policy/TooMuchCode/ProhibitUnusedInclude.pm lib/Perl/Critic/TooMuchCode.pm t/TooMuchCode/ProhibitDuplicateLiteral.run t/TooMuchCode/ProhibitDuplicateSub.run t/TooMuchCode/ProhibitExcessiveColons.run t/TooMuchCode/ProhibitExtraStricture.run t/TooMuchCode/ProhibitLargeBlock.run t/TooMuchCode/ProhibitLargeTryBlock.run t/TooMuchCode/ProhibitUnnecessaryScalarKeyword.run t/TooMuchCode/ProhibitUnusedConstant.run t/TooMuchCode/ProhibitUnusedImport.run t/TooMuchCode/ProhibitUnusedInclude.run t/all.t t/ignored-modules.t t/large_block.t t/moose-types.t t/require.t ProhibitUnusedConstant.run000644001751001751 206314425173124 25232 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19/t/TooMuchCode## name complex case 1 ## failures 1 ## cut use constant { PI => 4 * CORE::atan2(1, 1), ANS => 42 }; say PI; ## name complex case 2 ## failures 2 ## cut use constant { PI => 4 * CORE::atan2(1, 1), ANS => 42 }; say 42; ## name Basic ## failures 1 ## cut use constant ANSWER => 42; say 42; ## name Basic 1 ## failures 2 ## cut use constant QUESTION => 42; use constant ANSWER => 42; say 42; ## name constant in constant ## failures 0 ## cut use constant A => 42; use constant B => A + 42; say B; ## name constant in HashRef with a preceeding plus sign. ## failures 2 ## cut use constant +{ FOO => 1, BAR => 2, }; say 42; ## name constant in HashRef ## failures 2 ## cut use constant { FOO => 1, BAR => 2, }; say 42; ## name constant used in ternery op ## failures 0 ## cut use constant FOO => 1; use constant BAR => 2; $x = $y ? FOO : BAR; ## name constant in EXPORT ## failures 0 ## cut use constant TAU => 6.28; our @EXPORT = qw(TAU); ## name constant in EXPORT_OK ## failures 0 ## cut use constant TAU => 6.28; our @EXPORT_OK = qw(TAU); ProhibitUnnecessaryScalarKeyword.run000644001751001751 11114425173124 27217 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19/t/TooMuchCode## name simple ## failures 1 ## cut my @a = (1..30); my $n = scalar @n; ProhibitExcessiveColons.run000644001751001751 32014425173124 25343 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19/t/TooMuchCode## name double ## failures 0 ## cut use Data::Dumper; print 42; ## name quadruple ## failures 1 ## cut use Data::::Dumper; print 42; ## name sextuble ## failures 1 ## cut use Data::::::Dumper; print 42; cpanfile000644001751001751 34114425173124 17073 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19requires 'Perl::Critic'; requires 'PPIx::QuoteLike'; requires 'PPIx::Utils', '0.002'; requires 'List::Util', '1.50'; requires 'Scalar::Util', '1.50'; requires 'version', '0.77'; on test => sub { requires 'Test2::V0'; }; ProhibitExtraStricture.pm000644001751001751 553314425173124 30743 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19/lib/Perl/Critic/Policy/TooMuchCodepackage Perl::Critic::Policy::TooMuchCode::ProhibitExtraStricture; use strict; use warnings; use version 0.77; use Perl::Critic::Utils ':booleans'; use Perl::Critic::Utils::Constants qw(@STRICT_EQUIVALENT_MODULES); use parent 'Perl::Critic::Policy'; sub default_themes { return qw( maintenance ) } sub applies_to { return 'PPI::Document' } sub supported_parameters { return ( { name => 'stricture_modules', description => 'Modules which enables strictures.', behavior => 'string list', list_always_present_values => [ @STRICT_EQUIVALENT_MODULES, 'Test2::V0', ], } ); } #--------------------------------------------------------------------------- sub violates { my ( $self, $elem, $doc ) = @_; my @violations; my @includes = grep { $_->type eq "use" } @{ $doc->find('PPI::Statement::Include') ||[] }; my @st_strict_pragma = grep { $_->pragma eq "strict" } @includes; my $version_statement = $doc->find_first( sub { $_[1]->version } ); if (@st_strict_pragma == 1) { my %is_stricture_module = %{$self->{_stricture_modules}}; my @st_strict_module = grep { $is_stricture_module{ $_ } } map { $_->module } @includes; if ($version_statement) { my $version = version->parse( $version_statement->version ); if ( $version >= qv('v5.11.0') ) { push @st_strict_module, $version; } } if (@st_strict_module) { push @violations, $self->violation( "This `use strict` is redundant since ". $st_strict_module[0] . " also in place", "stricture is implied when using " . $st_strict_module[0] . ". Therefore there is no need to `use strict` in the same scope.", $st_strict_pragma[0], ) } } return @violations; } 1; =encoding utf-8 =head1 NAME TooMuchCode::ProhibitExtraStricture -- Find unnecessary 'use strict' =head1 DESCRIPTION Code stricture is good but that does not mean you always need to put C in your code. Several other modules enable code stricture in the current scope, effectively the same having C Here's a list of those modules: Moose Mouse Moo Mo Moose::Role Mouse::Role Moo::Role Test2::V0 When one of these modules are used, C is considered redundant and is marked as violation by this policy. =head2 Configuration The builtin list of stricture modules is obviously not comprehensive. You could extend the list by setting the C in the config. For example, with the following setting, two modules, C and C, are appended to the list of stricture modules. [TooMuchCode::ProhibitExtraStricture] stricture_modules = Foo Bar =cut 1; README000644001751001751 70314425173124 16251 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19NAME Perl::Critic::TooMuchCode - perlcritic add-ons that generally check for dead code. DESCRIPTION This add-on for Perl::Critic is aiming for identifying trivial dead code. Either the ones that has no use, or the one that produce no effect. Having dead code floating around causes maintenance burden. Some might prefer not to generate them in the first place. AUTHOR Kang-min Liu LICENSE MIT Build.PL000644001751001751 20114425173124 16656 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19# This Build.PL for Perl-Critic-TooMuchCode was generated by mbtiny 0.041. use 5.008; use Module::Build::Tiny 0.039; Build_PL(); LICENSE000644001751001751 223114425173124 16414 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19This software is Copyright (c) 2023 by Kang-min Liu . This is free software, licensed under: The MIT (X11) License The MIT License Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ProhibitUnusedInclude.pm000644001751001751 4315514425173124 30544 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19/lib/Perl/Critic/Policy/TooMuchCodepackage Perl::Critic::Policy::TooMuchCode::ProhibitUnusedInclude; use strict; use warnings; use Scalar::Util qw(refaddr); use Perl::Critic::Utils; use parent 'Perl::Critic::Policy'; sub default_themes { return qw( maintenance ) } sub applies_to { return 'PPI::Document' } sub supported_parameters { return ( +{ name => 'ignore', description => 'List of modules to be disregarded. Separated by whitespaces.', behavior => 'string list', } ) } #--------------------------------------------------------------------------- use constant { ## Some modules works like pragmas -- their very existence in the code implies that they are used. PRAGMATIST => { map { $_ => 1 } qw( Moose Mouse Moo Mo Test::NoWarnings ) }, TRY_FAMILY => { map { $_ => 1 } qw(Try::Tiny Try::Catch Try::Lite TryCatch Try) }, ## These are the modules that, when used, the module name itself appears in the code. USE_BY_MODULE_NAME => { map { $_ => 1 } qw(Hijk HTTP::Tiny HTTP::Lite LWP::UserAgent File::Spec) }, ## this mapping fines a set of modules with behaviour that introduce ## new words as subroutine names or method names when they are `use`ed ## without arguments. #### for mod in $(perlbrew list-modules) Test2::V0; do perl -M${mod} -l -e 'if (my @e = grep /\A\w+\z/, (@'$mod'::EXPORT) ) { print "### \x27'$mod'\x27 => [qw(@e)],"; }' \; 2>/dev/null | grep '^### ' | cut -c 5- ; done DEFAULT_EXPORT => { 'App::ModuleBuildTiny' => [qw(modulebuildtiny)], 'B::Hooks::EndOfScope' => [qw(on_scope_end)], 'Carp::Assert' => [qw(assert affirm should shouldnt DEBUG assert affirm should shouldnt DEBUG)], 'Carp::Assert::More' => [qw(assert_all_keys_in assert_arrayref assert_coderef assert_defined assert_empty assert_exists assert_fail assert_hashref assert_in assert_integer assert_is assert_isa assert_isa_in assert_isnt assert_lacks assert_like assert_listref assert_negative assert_negative_integer assert_nonblank assert_nonempty assert_nonnegative assert_nonnegative_integer assert_nonref assert_nonzero assert_nonzero_integer assert_numeric assert_positive assert_positive_integer assert_undefined assert_unlike)], 'Class::Method::Modifiers' => [qw(before after around)], 'Compress::Raw::Bzip2' => [qw(BZ_RUN BZ_FLUSH BZ_FINISH BZ_OK BZ_RUN_OK BZ_FLUSH_OK BZ_FINISH_OK BZ_STREAM_END BZ_SEQUENCE_ERROR BZ_PARAM_ERROR BZ_MEM_ERROR BZ_DATA_ERROR BZ_DATA_ERROR_MAGIC BZ_IO_ERROR BZ_UNEXPECTED_EOF BZ_OUTBUFF_FULL BZ_CONFIG_ERROR)], 'Compress::Raw::Zlib' => [qw(ZLIB_VERSION ZLIB_VERNUM OS_CODE MAX_MEM_LEVEL MAX_WBITS Z_ASCII Z_BEST_COMPRESSION Z_BEST_SPEED Z_BINARY Z_BLOCK Z_BUF_ERROR Z_DATA_ERROR Z_DEFAULT_COMPRESSION Z_DEFAULT_STRATEGY Z_DEFLATED Z_ERRNO Z_FILTERED Z_FIXED Z_FINISH Z_FULL_FLUSH Z_HUFFMAN_ONLY Z_MEM_ERROR Z_NEED_DICT Z_NO_COMPRESSION Z_NO_FLUSH Z_NULL Z_OK Z_PARTIAL_FLUSH Z_RLE Z_STREAM_END Z_STREAM_ERROR Z_SYNC_FLUSH Z_TREES Z_UNKNOWN Z_VERSION_ERROR WANT_GZIP WANT_GZIP_OR_ZLIB crc32 adler32 DEF_WBITS)], 'Cookie::Baker' => [qw(bake_cookie crush_cookie)], 'Cpanel::JSON::XS' => [qw(encode_json decode_json to_json from_json)], 'Crypt::RC4' => [qw(RC4)], 'DBIx::DSN::Resolver::Cached' => [qw(dsn_resolver)], 'DBIx::DisconnectAll' => [qw(dbi_disconnect_all)], 'Data::Clone' => [qw(clone)], 'Data::Compare' => [qw(Compare)], 'Data::Dump' => [qw(dd ddx)], 'Data::NestedParams' => [qw(expand_nested_params collapse_nested_params)], 'Data::UUID' => [qw(NameSpace_DNS NameSpace_OID NameSpace_URL NameSpace_X500)], 'Data::Validate::Domain' => [qw(is_domain is_hostname is_domain_label)], 'Data::Validate::IP' => [qw(is_ip is_ipv4 is_ipv6 is_innet_ipv4 is_multicast_ipv4 is_testnet_ipv4 is_anycast_ipv4 is_loopback_ipv4 is_private_ipv4 is_unroutable_ipv4 is_linklocal_ipv4 is_public_ipv4 is_loopback_ipv6 is_orchid_ipv6 is_special_ipv6 is_multicast_ipv6 is_private_ipv6 is_linklocal_ipv6 is_ipv4_mapped_ipv6 is_documentation_ipv6 is_teredo_ipv6 is_discard_ipv6 is_public_ipv6 is_linklocal_ip is_loopback_ip is_multicast_ip is_private_ip is_public_ip)], 'Data::Walk' => [qw(walk walkdepth)], 'Devel::CheckCompiler' => [qw(check_c99 check_c99_or_exit check_compile)], 'Devel::CheckLib' => [qw(assert_lib check_lib_or_exit check_lib)], 'Devel::GlobalDestruction' => [qw(in_global_destruction)], 'Dist::CheckConflicts' => [qw(conflicts check_conflicts calculate_conflicts dist)], 'Email::MIME::ContentType' => [qw(parse_content_type parse_content_disposition)], 'Encode' => [qw(decode decode_utf8 encode encode_utf8 str2bytes bytes2str encodings find_encoding find_mime_encoding clone_encoding)], 'Eval::Closure' => [qw(eval_closure)], 'ExtUtils::MakeMaker' => [qw(WriteMakefile prompt os_unsupported)], 'File::HomeDir' => [qw(home)], 'File::Listing' => [qw(parse_dir)], 'File::Path' => [qw(mkpath rmtree)], 'File::ShareDir::Install' => [qw(install_share delete_share)], 'File::Which' => [qw(which)], 'File::Zglob' => [qw(zglob)], 'File::pushd' => [qw(pushd tempd)], 'Graphics::ColorUtils' => [qw(rgb2yiq yiq2rgb rgb2cmy cmy2rgb rgb2hls hls2rgb rgb2hsv hsv2rgb)], 'HTML::Escape' => [qw(escape_html)], 'HTTP::Date' => [qw(time2str str2time)], 'HTTP::Negotiate' => [qw(choose)], 'IO::All' => [qw(io)], 'IO::HTML' => [qw(html_file)], 'IO::Socket::SSL' => [qw(SSL_WANT_READ SSL_WANT_WRITE SSL_VERIFY_NONE SSL_VERIFY_PEER SSL_VERIFY_FAIL_IF_NO_PEER_CERT SSL_VERIFY_CLIENT_ONCE SSL_OCSP_NO_STAPLE SSL_OCSP_TRY_STAPLE SSL_OCSP_MUST_STAPLE SSL_OCSP_FAIL_HARD SSL_OCSP_FULL_CHAIN GEN_DNS GEN_IPADD)], 'IPC::Run3' => [qw(run3)], 'JSON' => [qw(from_json to_json jsonToObj objToJson encode_json decode_json)], 'JSON::MaybeXS' => [qw(encode_json decode_json JSON)], 'JSON::PP' => [qw(encode_json decode_json from_json to_json)], 'JSON::Types' => [qw(number string bool)], 'JSON::XS' => [qw(encode_json decode_json)], 'LWP::MediaTypes' => [qw(guess_media_type media_suffix)], 'Lingua::JA::Regular::Unicode' => [qw(hiragana2katakana alnum_z2h alnum_h2z space_z2h katakana2hiragana katakana_h2z katakana_z2h space_h2z)], 'Locale::Currency::Format' => [qw(currency_format currency_name currency_set currency_symbol decimal_precision decimal_separator thousands_separator FMT_NOZEROS FMT_STANDARD FMT_COMMON FMT_SYMBOL FMT_HTML FMT_NAME SYM_UTF SYM_HTML)], 'Log::Minimal' => [qw(critf critff warnf warnff infof infoff debugf debugff croakf croakff ddf)], 'MIME::Charset' => [qw(body_encoding canonical_charset header_encoding output_charset body_encode encoded_header_len header_encode)], 'Math::Round' => [qw(round nearest)], 'Module::Build::Tiny' => [qw(Build Build_PL)], 'Module::Find' => [qw(findsubmod findallmod usesub useall setmoduledirs)], 'Module::Functions' => [qw(get_public_functions)], 'Module::Spy' => [qw(spy_on)], 'PLON' => [qw(encode_plon decode_pson)], 'Path::Class' => [qw(file dir)], 'Path::Tiny' => [qw(path)], 'Proc::Wait3' => [qw(wait3)], 'Readonly' => [qw(Readonly)], 'SQL::QueryMaker' => [qw(sql_op sql_raw sql_and sql_or sql_in sql_not_in sql_ne sql_not sql_like sql_is_not_null sql_is_null sql_ge sql_gt sql_eq sql_lt sql_le sql_between sql_not_between)], 'Smart::Args' => [qw(args args_pos)], 'Socket' => [qw(PF_802 PF_AAL PF_APPLETALK PF_CCITT PF_CHAOS PF_CTF PF_DATAKIT PF_DECnet PF_DLI PF_ECMA PF_GOSIP PF_HYLINK PF_IMPLINK PF_INET PF_INET6 PF_ISO PF_KEY PF_LAST PF_LAT PF_LINK PF_MAX PF_NBS PF_NIT PF_NS PF_OSI PF_OSINET PF_PUP PF_ROUTE PF_SNA PF_UNIX PF_UNSPEC PF_USER PF_WAN PF_X25 AF_802 AF_AAL AF_APPLETALK AF_CCITT AF_CHAOS AF_CTF AF_DATAKIT AF_DECnet AF_DLI AF_ECMA AF_GOSIP AF_HYLINK AF_IMPLINK AF_INET AF_INET6 AF_ISO AF_KEY AF_LAST AF_LAT AF_LINK AF_MAX AF_NBS AF_NIT AF_NS AF_OSI AF_OSINET AF_PUP AF_ROUTE AF_SNA AF_UNIX AF_UNSPEC AF_USER AF_WAN AF_X25 SOCK_DGRAM SOCK_RAW SOCK_RDM SOCK_SEQPACKET SOCK_STREAM SOL_SOCKET SO_ACCEPTCONN SO_ATTACH_FILTER SO_BACKLOG SO_BROADCAST SO_CHAMELEON SO_DEBUG SO_DETACH_FILTER SO_DGRAM_ERRIND SO_DOMAIN SO_DONTLINGER SO_DONTROUTE SO_ERROR SO_FAMILY SO_KEEPALIVE SO_LINGER SO_OOBINLINE SO_PASSCRED SO_PASSIFNAME SO_PEERCRED SO_PROTOCOL SO_PROTOTYPE SO_RCVBUF SO_RCVLOWAT SO_RCVTIMEO SO_REUSEADDR SO_REUSEPORT SO_SECURITY_AUTHENTICATION SO_SECURITY_ENCRYPTION_NETWORK SO_SECURITY_ENCRYPTION_TRANSPORT SO_SNDBUF SO_SNDLOWAT SO_SNDTIMEO SO_STATE SO_TYPE SO_USELOOPBACK SO_XOPEN SO_XSE IP_HDRINCL IP_OPTIONS IP_RECVOPTS IP_RECVRETOPTS IP_RETOPTS IP_TOS IP_TTL MSG_BCAST MSG_BTAG MSG_CTLFLAGS MSG_CTLIGNORE MSG_CTRUNC MSG_DONTROUTE MSG_DONTWAIT MSG_EOF MSG_EOR MSG_ERRQUEUE MSG_ETAG MSG_FASTOPEN MSG_FIN MSG_MAXIOVLEN MSG_MCAST MSG_NOSIGNAL MSG_OOB MSG_PEEK MSG_PROXY MSG_RST MSG_SYN MSG_TRUNC MSG_URG MSG_WAITALL MSG_WIRE SHUT_RD SHUT_RDWR SHUT_WR INADDR_ANY INADDR_BROADCAST INADDR_LOOPBACK INADDR_NONE SCM_CONNECT SCM_CREDENTIALS SCM_CREDS SCM_RIGHTS SCM_TIMESTAMP SOMAXCONN IOV_MAX UIO_MAXIOV sockaddr_family pack_sockaddr_in unpack_sockaddr_in sockaddr_in pack_sockaddr_in6 unpack_sockaddr_in6 sockaddr_in6 pack_sockaddr_un unpack_sockaddr_un sockaddr_un inet_aton inet_ntoa)], 'String::Format' => [qw(stringf)], 'String::ShellQuote' => [qw(shell_quote shell_quote_best_effort shell_comment_quote)], 'Sub::Name' => [qw(subname)], 'Sub::Quote' => [qw(quote_sub unquote_sub quoted_from_sub qsub)], 'Sub::Retry' => [qw(retry)], 'Teng::Plugin::TextTable' => [qw(draw_text_table)], 'Test2::V0' => [qw(ok pass fail diag note todo skip plan skip_all done_testing bail_out intercept context gen_event def do_def cmp_ok warns warning warnings no_warnings subtest can_ok isa_ok DOES_ok set_encoding imported_ok not_imported_ok ref_ok ref_is ref_is_not mock mocked dies lives try_ok is like isnt unlike match mismatch validator hash array bag object meta meta_check number float rounded within string subset bool in_set not_in_set check_set item field call call_list call_hash prop check all_items all_keys all_vals all_values etc end filter_items T F D DF E DNE FDNE U event fail_events exact_ref)], 'Test::BinaryData' => [qw(is_binary)], 'Test::Deep' => [qw(Isa blessed obj_isa all any array array_each arrayelementsonly arraylength arraylengthonly bag bool cmp_bag cmp_deeply cmp_methods cmp_set code eq_deeply hash hash_each hashkeys hashkeysonly ignore isa listmethods methods noclass none noneof num re reftype regexpmatches regexponly regexpref regexprefonly scalarrefonly scalref set shallow str subbagof subhashof subsetof superbagof superhashof supersetof useclass)], 'Test::Differences' => [qw(eq_or_diff eq_or_diff_text eq_or_diff_data unified_diff context_diff oldstyle_diff table_diff)], 'Test::Exception' => [qw(dies_ok lives_ok throws_ok lives_and)], 'Test::Fatal' => [qw(exception)], 'Test::Kantan' => [qw(Feature Scenario Given When Then subtest done_testing setup teardown describe context it before_each after_each expect ok diag ignore spy_on skip_all)], 'Test::LongString' => [qw(is_string is_string_nows like_string unlike_string contains_string lacks_string)], 'Test::Mock::Guard' => [qw(mock_guard)], 'Test::More' => [qw(ok use_ok require_ok is isnt like unlike is_deeply cmp_ok skip todo todo_skip pass fail eq_array eq_hash eq_set plan done_testing can_ok isa_ok new_ok diag note explain subtest BAIL_OUT)], 'Test::Object' => [qw(object_ok)], 'Test::Output' => [qw(output_like stderr_from output_isnt stderr_is stdout_unlike combined_isnt output_is combined_is stdout_is stderr_isnt stdout_like combined_unlike stderr_unlike output_from combined_from stdout_isnt output_unlike combined_like stdout_from stderr_like)], 'Test::Simple' => [qw(ok)], 'Test::Spec' => [qw(runtests describe xdescribe context xcontext it xit they xthey before after around yield spec_helper share shared_examples_for it_should_behave_like)], 'Test::Stub' => [qw(stub make_stub)], 'Test::SubCalls' => [qw(sub_track sub_calls sub_reset sub_reset_all)], 'Test::TempDir::Tiny' => [qw(tempdir in_tempdir)], 'Test::TCP' => [qw(empty_port test_tcp wait_port)], 'Test::Warn' => [qw(warning_is warnings_are warning_like warnings_like warnings_exist)], 'Text::Diff' => [qw(diff)], 'Time::Piece' => [qw(localtime gmtime)], 'Try::Tiny' => [qw(try catch finally)], 'URI::Find' => [qw(find_uris)], 'URL::Builder' => [qw(build_url build_url_utf8)], 'UUID::Tiny' => [qw(UUID_NIL UUID_NS_DNS UUID_NS_URL UUID_NS_OID UUID_NS_X500 UUID_V1 UUID_V3 UUID_V4 UUID_V5 UUID_SHA1_AVAIL create_UUID create_UUID_as_string is_UUID_string UUID_to_string string_to_UUID version_of_UUID time_of_UUID clk_seq_of_UUID equal_UUIDs)], 'Want' => [qw(want rreturn lnoreturn)], 'XML::Simple' => [qw(XMLin XMLout)], 'YAML' => [qw(Dump Load)], } }; sub violates { my ( $self, $elem, $doc ) = @_; my @includes = grep { my $mod = $_->module; !$_->pragma && $mod && (! $self->{_ignore}{$mod}) } @{ $doc->find('PPI::Statement::Include') ||[] }; return () unless @includes; return () if grep { $_->module eq 'Module::Functions' } @includes; my %uses; $self->gather_uses_pragmatists(\@includes, $doc, \%uses); $self->gather_uses_try_family(\@includes, $doc, \%uses); $self->gather_uses_generic(\@includes, $doc, \%uses); return map { $self->violation( "Unused include: " . $_->module, "A module is `use`-ed but not really consumed in other places in the code", $_ ) } grep { my $mod = $_->module; (! $uses{refaddr($_)}) && (TRY_FAMILY->{$mod} || DEFAULT_EXPORT->{$mod} || USE_BY_MODULE_NAME->{$mod}) } @includes; } sub gather_uses_pragmatists { my ( $self, $includes, $doc, $uses ) = @_; for (grep { PRAGMATIST->{$_->module} } @$includes) { my $r = refaddr($_); $uses->{$r} = 1; } } sub gather_uses_generic { my ( $self, $includes, $doc, $uses ) = @_; my @words = grep { ! $_->statement->isa('PPI::Statement::Include') } @{ $doc->find('PPI::Token::Word') || []}; my @mods = grep { !$uses->{$_} } map { $_->module } @$includes; my @inc_without_args; for my $inc (@$includes) { if ($inc->arguments) { my $r = refaddr($inc); $uses->{$r} = -1; } else { push @inc_without_args, $inc; } } for my $word (@words) { for my $inc (@inc_without_args) { my $mod = $inc->module; my $r = refaddr($inc); next if $uses->{$r}; $uses->{$r} = 1 if ($word->content =~ /\A $mod (\z|::)/x) || (grep { $_ eq $word } @{DEFAULT_EXPORT->{$mod} ||[]}) || ("$word" eq "$inc"); } } } sub gather_uses_try_family { my ( $self, $includes, $doc, $uses ) = @_; my @uses_tryish_modules = grep { TRY_FAMILY->{$_->module} } @$includes; return unless @uses_tryish_modules; my $has_try_block = 0; for my $try_keyword (@{ $doc->find(sub { $_[1]->isa('PPI::Token::Word') && $_[1]->content eq 'try' }) ||[]}) { my $try_block = $try_keyword->snext_sibling or next; next unless $try_block->isa('PPI::Structure::Block'); $has_try_block = 1; last; } return unless $has_try_block; $uses->{refaddr($_)} = 1 for @uses_tryish_modules; } 1; =encoding utf-8 =head1 NAME TooMuchCode::ProhibitUnusedInclude -- Find unused include statements. =head1 DESCRIPTION This critic policy scans for unused include statement according to their documentation. For example, L implicitly introduce a C subroutine that takes a block. Therefore, a lonely C statement without a C block somewhere in its scope is considered to be an "Unused Include". Notice: This module use a hard-coded list of commonly-used CPAN modules with symbols exported from them. Although it is relatively static, it needs to be revised from time to time. =cut all.t000644001751001751 21714425173124 16571 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19/tuse strict; use Test::Perl::Critic::Policy qw< all_policies_ok >; my %args = @ARGV ? ( -policies => [ @ARGV ] ) : (); all_policies_ok(%args); moose-types.t000644001751001751 144214425173124 20326 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19/t#!perl use strict; use Perl::Critic (); use Perl::Critic::Utils qw{ :severities }; use Test::More; use constant POLICY => 'Perl::Critic::Policy::TooMuchCode::ProhibitUnusedImport'; { my $pc = Perl::Critic->new( -only => 1 ); $pc->add_policy( -policy => POLICY, -params => { moose_type_modules => 'My::Types::Moose' }, ); my $code = q~ use strict; use MooseX::Types::Moose qw( Int ); use My::Types::Moose qw( ArrayRef Bool ); has => ( is => 'ro', isa => Bool, ); my $foo = undef; if ( is_Int( $foo ) ) { ...; } my $bar = to_ArrayRef('thing'); ~; my @violations = $pc->critique( \$code ); ok(!@violations, 'no violations'); } done_testing(); META.json000644001751001751 662014425173124 17036 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19{ "abstract" : "perlcritic add-ons that generally check for dead code.", "author" : [ "Kang-min Liu " ], "dynamic_config" : 0, "generated_by" : "App::ModuleBuildTiny version 0.041", "license" : [ "mit" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Perl-Critic-TooMuchCode", "prereqs" : { "configure" : { "requires" : { "Module::Build::Tiny" : "0.039" } }, "develop" : { "requires" : { "App::ModuleBuildTiny" : "0.041" } }, "runtime" : { "requires" : { "List::Util" : "1.50", "PPIx::QuoteLike" : "0", "PPIx::Utils" : "0.002", "Perl::Critic" : "0", "Scalar::Util" : "1.50", "version" : "0.77" } }, "test" : { "requires" : { "Test2::V0" : "0" } } }, "provides" : { "Perl::Critic::Policy::TooMuchCode::ProhibitDuplicateLiteral" : { "file" : "lib/Perl/Critic/Policy/TooMuchCode/ProhibitDuplicateLiteral.pm" }, "Perl::Critic::Policy::TooMuchCode::ProhibitDuplicateSub" : { "file" : "lib/Perl/Critic/Policy/TooMuchCode/ProhibitDuplicateSub.pm" }, "Perl::Critic::Policy::TooMuchCode::ProhibitExcessiveColons" : { "file" : "lib/Perl/Critic/Policy/TooMuchCode/ProhibitExcessiveColons.pm", "version" : "0.01" }, "Perl::Critic::Policy::TooMuchCode::ProhibitExtraStricture" : { "file" : "lib/Perl/Critic/Policy/TooMuchCode/ProhibitExtraStricture.pm" }, "Perl::Critic::Policy::TooMuchCode::ProhibitLargeBlock" : { "file" : "lib/Perl/Critic/Policy/TooMuchCode/ProhibitLargeBlock.pm" }, "Perl::Critic::Policy::TooMuchCode::ProhibitLargeTryBlock" : { "file" : "lib/Perl/Critic/Policy/TooMuchCode/ProhibitLargeTryBlock.pm" }, "Perl::Critic::Policy::TooMuchCode::ProhibitUnnecessaryScalarKeyword" : { "file" : "lib/Perl/Critic/Policy/TooMuchCode/ProhibitUnnecessaryScalarKeyword.pm" }, "Perl::Critic::Policy::TooMuchCode::ProhibitUnnecessaryUTF8Pragma" : { "file" : "lib/Perl/Critic/Policy/TooMuchCode/ProhibitUnnecessaryUTF8Pragma.pm" }, "Perl::Critic::Policy::TooMuchCode::ProhibitUnusedConstant" : { "file" : "lib/Perl/Critic/Policy/TooMuchCode/ProhibitUnusedConstant.pm" }, "Perl::Critic::Policy::TooMuchCode::ProhibitUnusedImport" : { "file" : "lib/Perl/Critic/Policy/TooMuchCode/ProhibitUnusedImport.pm" }, "Perl::Critic::Policy::TooMuchCode::ProhibitUnusedInclude" : { "file" : "lib/Perl/Critic/Policy/TooMuchCode/ProhibitUnusedInclude.pm" }, "Perl::Critic::TooMuchCode" : { "file" : "lib/Perl/Critic/TooMuchCode.pm", "version" : "0.19" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/gugod/Perl-Critic-TooMuchCode/issues" }, "repository" : { "type" : "git", "url" : "https://github.com/gugod/Perl-Critic-TooMuchCode.git", "web" : "https://github.com/gugod/Perl-Critic-TooMuchCode" } }, "version" : "0.19", "x_serialization_backend" : "JSON::PP version 4.07", "x_spdx_expression" : "MIT", "x_static_install" : "1" } ProhibitUnusedConstant.pm000644001751001751 425114425173124 30724 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19/lib/Perl/Critic/Policy/TooMuchCodepackage Perl::Critic::Policy::TooMuchCode::ProhibitUnusedConstant; use strict; use warnings; use Perl::Critic::Utils; use PPIx::Utils::Traversal qw(get_constant_name_elements_from_declaring_statement); use Scalar::Util qw(refaddr); use parent 'Perl::Critic::Policy'; use Perl::Critic::TooMuchCode; sub default_themes { return qw( maintenance ) } sub applies_to { return 'PPI::Document' } #--------------------------------------------------------------------------- sub violates { my ( $self, $elem, $doc ) = @_; my %defined_constants; my %used; my $include_statements = $elem->find(sub { $_[1]->isa('PPI::Statement::Include') }) || []; for my $st (@$include_statements) { next unless $st->schild(0) eq 'use' && $st->module eq 'constant'; my @constants = get_constant_name_elements_from_declaring_statement( $st ); for my $tok (@constants) { push @{ $defined_constants{"$tok"} }, $st; } } for my $el_word (@{ $elem->find( sub { $_[1]->isa('PPI::Token::Word') }) ||[]}) { my $st = $el_word->statement; if ($defined_constants{"$el_word"}) { for my $st (@{ $defined_constants{"$el_word"} }) { unless ($el_word->descendant_of($st)) { $used{"$el_word"}++; } } } } Perl::Critic::TooMuchCode::__get_symbol_usage(\%used, $doc); my @violations; my @to_report = grep { !$used{$_} } (sort keys %defined_constants); for my $tok (@to_report) { for my $el (@{ $defined_constants{$tok} }) { push @violations, $self->violation( 'Unused constant', "A constant <$tok> is defined but not used.", $el ); } } return @violations; } 1; =encoding utf-8 =head1 NAME TooMuchCode::ProhibitUnusedConstant -- Find unused constants. =head1 DESCRIPTION This policy finds constant declarations by "constant" pragma, and further looks to see if they exist in the rest of the code. (The scope of searching is within the same file.) It identifies constants defined in two simple forms, such as: use constant PI => 3.14; ... and use constant { PI => 3.14, TAU => 6.28 }; =cut ProhibitUnusedImport.pm000644001751001751 1512314425173124 30425 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19/lib/Perl/Critic/Policy/TooMuchCodepackage Perl::Critic::Policy::TooMuchCode::ProhibitUnusedImport; use strict; use warnings; use Perl::Critic::Utils; use parent 'Perl::Critic::Policy'; use Perl::Critic::TooMuchCode; use Perl::Critic::Policy::Variables::ProhibitUnusedVariables; sub default_themes { return qw( maintenance ) } sub applies_to { return 'PPI::Document' } sub supported_parameters { return ( { name => 'ignored_modules', description => 'Modules which will be ignored by this policy.', behavior => 'string list', list_always_present_values => [ 'Exporter', 'Getopt::Long', 'Git::Sub', 'MooseX::Foreign', 'MouseX::Foreign', 'Test::Needs', 'Test::Requires', 'Test::RequiresInternet', ], }, { name => 'moose_type_modules', description => 'Modules which import Moose-like types.', behavior => 'string list', list_always_present_values => [ 'MooseX::Types::Moose', 'MooseX::Types::Common::Numeric', 'MooseX::Types::Common::String', ], }, ); } #--------------------------------------------------------------------------- sub violates { my ( $self, $elem, $doc ) = @_; my $moose_types = $self->{_moose_type_modules}; my %imported; $self->gather_imports_generic( \%imported, $elem, $doc ); my %used; for my $el_word ( @{ $elem->find( sub { $_[1]->isa('PPI::Token::Word') || ( $_[1]->isa('PPI::Token::Symbol') && $_[1]->symbol_type eq '&' ); } ) || [] } ) { if ( $el_word->isa('PPI::Token::Symbol') ) { $el_word =~ s{^&}{}; } $used{"$el_word"}++; } Perl::Critic::TooMuchCode::__get_symbol_usage(\%used, $doc); my @violations; my @to_report = grep { !$used{$_} } (keys %imported); # Maybe filter out Moose types. if ( @to_report ) { my %to_report = map { $_ => 1 } @to_report; for my $import ( keys %to_report ) { if ( exists $used{ 'is_' . $import } || exists $used { 'to_' . $import } && exists $moose_types->{$imported{$import}->[0]} ) { delete $to_report{$import}; } } @to_report = keys %to_report; } @to_report = sort { $a cmp $b } @to_report; for my $tok (@to_report) { for my $inc_mod (@{ $imported{$tok} }) { push @violations, $self->violation( "Unused import: $tok", "A token is imported but not used in the same code.", $inc_mod ); } } return @violations; } sub gather_imports_generic { my ( $self, $imported, $elem, $doc ) = @_; my $is_ignored = $self->{_ignored_modules}; my $include_statements = $elem->find(sub { $_[1]->isa('PPI::Statement::Include') && !$_[1]->pragma }) || []; for my $st (@$include_statements) { next if $st->schild(0) eq 'no'; my $expr_qw = $st->find( sub { $_[1]->isa('PPI::Token::QuoteLike::Words'); }) or next; my $included_module = $st->schild(1); next if exists $is_ignored->{$included_module}; if (@$expr_qw == 1) { my $expr = $expr_qw->[0]; my @words = $expr_qw->[0]->literal; for my $w (@words) { next if $w =~ /\A [:\-\+]/x; push @{ $imported->{$w} //=[] }, $included_module; } } } } 1; =encoding utf-8 =head1 NAME TooMuchCode::ProhibitUnusedImport -- Find unused imports =head1 DESCRIPTION An "import" is a subroutine brought by a C statement. From the documentation of L, there are several forms of calling `use`. This policy scans for the following two forms: use Module VERSION LIST use Module LIST ... and only the one with LIST written in C. Conventionally the LIST after c is known as arguments and conventionally when it is written with C, the LIST is treated as a import list -- which is a list of symbols that becomes avaiable in the current namespace. For example, the word C in the following statement is one of such: use Foo qw( baz ); Symbols in the import list are often subroutine names or variable names. If they are not used in the following program, they do not neet to be imported. Although an experienced perl programmer would know that the description above is only true by convention, there are many modules on CPAN that already follows such convetion. Which is a good one to follow, and I recommend you to follow. This policy checks only import lists written in C, other forms are ignored, or rather, too complicated to be correctly supported. The syntax of C module is also supported, but only the ones with C at the end. use Importer 'Foo' => qw( baz ); Modules with non-trivial form of arguments may have nothing to with symbol-importing. But it might be used with a C LIST at the end. Should you wish to do so, you may let chose to let perlcritic to ignore certain modules by setting the C in C<.perlcriticrc>. For example: [TooMuchCode::ProhibitUnusedImport] ignored_modules = Git::Sub Regexp::Common Alternatively, you may choose not to write the module arguments as a C list. =head2 Moose Types Moose Types can also be imported, but their symbols may not be used as-is. Instead, some other helper functions are generated with names based on the Type. For example: use My::Type::Library::Numeric qw( PositiveInt ); use My::Type::Library::String qw( LowerCaseStr ); my $foo = 'Bar'; my $ok = is_PositiveInt($foo); my $lower = to_LowerCaseStr($foo); The module C exports C as well as C. While C is not directly used in the following code, is should be considered as being used. Similar for C. When importing from a Type library, subroutines named like C and C are not in the import list, but they are also imported. By default, the following modules are treated as Type libraries * MooseX::Types::Moose * MooseX::Types::Common::Numeric * MooseX::Types::Common::String The list can be grown by including your module names to the C in the C<.perlcriticrc>: [TooMuchCode::ProhibitUnusedImport] moose_type_modules = My::Type::Library::Numeric My::Type::Library::String =cut require.t000644001751001751 65014425173124 17476 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19/tuse strict; use Test2::V0; use Test2::Tools::Exception qw/lives/; ok(lives { require Perl::Critic::TooMuchCode; require Perl::Critic::Policy::TooMuchCode::ProhibitLargeTryBlock; require Perl::Critic::Policy::TooMuchCode::ProhibitUnnecessaryUTF8Pragma; require Perl::Critic::Policy::TooMuchCode::ProhibitUnusedConstant; require Perl::Critic::Policy::TooMuchCode::ProhibitUnusedImport; }); done_testing; ProhibitDuplicateLiteral.run000644001751001751 341614425173124 25507 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19/t/TooMuchCode## name Cases with no violations ## failures 0 ## cut print 42; print 43; print "Forty two"; print "Forty three"; ## name trivial case of duplicate strings ## failures 1 ## cut print "Forty two"; print "Forty two"; ## name allowed duplicate string ## parms { allowlist => '"Forty two"' } ## failures 0 ## cut print "Forty two"; print "Forty two"; ## name multiple allowed duplicate strings ## parms { allowlist => '"Forty two" \'Forty three\'' } ## failures 0 ## cut print "Forty two"; print "Forty two"; print "Forty three"; print "Forty three"; ## name Strings with different different quote. ## failures 1 ## cut say 'Forty two'; say "Forty two"; ## name trivial case of duplicate numbers ## failures 1 ## cut my $n = 42; print 42; ## name trivial case of duplicate numbers ## failures 1 ## cut my $o = foo() ? 1 : 0; my $two = 1 + 1 + 0; my $n = 42; print 42; ## name duplicate numbers ## failures 1 ## cut if ($a < 42) { if ($b < 42) { print("Hello World") } } ## name certain duplicate numbers are OK ## parms { allowlist => '42' } ## failures 0 ## cut if ($a < 42) { if ($b < 42) { print("Hello World") } } ## name without allowlist ## failures 2 ## cut if ($a < 42) { if ($b < 42) { print("Hello World"); print("Hello World"); } } ## name with allowlist ## parms { allowlist => '42 "Hello World"' } ## failures 0 ## cut if ($a < 42) { if ($b < 42) { print("Hello World"); print("Hello World"); } } ## name numbers and their string counterpart ## parms { allowlist => '42' } ## failures 0 ## cut if ($a eq "42") { if ($b ne "42") { print("Hello World"); } } ## name strings and their numerical counterpart ## parms { allowlist => '"42"' } ## failures 0 ## cut if ($a == 42) { if ($b != 42) { print("Hello World"); } } ProhibitExcessiveColons.pm000644001751001751 325114425173124 31062 0ustar00gugodgugod000000000000Perl-Critic-TooMuchCode-0.19/lib/Perl/Critic/Policy/TooMuchCodepackage Perl::Critic::Policy::TooMuchCode::ProhibitExcessiveColons; use strict; use warnings; use Perl::Critic::Utils; use parent 'Perl::Critic::Policy'; our $VERSION = '0.01'; sub default_themes { return qw( maintenance ) } sub applies_to { return 'PPI::Statement::Include' } #--------------------------------------------------------------------------- sub violates { my ( $self, $elem, $doc ) = @_; my @violations = $self->gather_violations_generic($elem, $doc); return @violations; } sub gather_violations_generic { my ( $self, $elem, undef ) = @_; # PPI::Statement::Include doesn't handle this weird case of `use Data::::Dumper`. # The `PPI::Statement::Include#module` method does not catch 'Data::::Dumper' as the # module name, but `Data::` instead. # So we are just use strings here. return unless index("$elem", "::::") > 0; return $self->violation( "Too many colons in the module name.", "The statement <$elem> contains so many colons to separate namespaces, while 2 colons is usually enough.", $elem, ); } 1; =encoding utf-8 =head1 NAME TooMuchCode::ProhibitExcessiveColons - Finds '::::::::' in module names. =head1 DESCRIPTION In an include statement, it is possible to have a lot of colons: use Data::::Dumper; ... or use Data::::::::Dumper; As long as the number of colons is a multiple of two. However, just because it is doable, does not mean it is sensible. C will make perl look for C, which is usually the same as C. This policy restrict you to use only two colons to delimit one layer of namespace. =cut