From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

GUGOD / Perl-Critic-TooMuchCode-0.19 / lib / Perl / Critic / TooMuchCode.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
—
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93

              
package 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<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.
=head1 AUTHOR
Kang-min Liu <gugod@gugod.org>
=head1 LICENSE
MIT
=cut