public
Last active

Find unused Perl subroutines

  • Download Gist
find_unused_subs.pl
Perl
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 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116
#!/usr/bin/perl
use v5.14;
use strict;
use warnings;
 
use PPI;
use Scalar::Util qw(blessed);
 
 
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# Create the PPI document, and add an isa method that takes a list
sub PPI::Element::isa {
my( $self, @classes ) = @_;
foreach my $class ( @classes ) {
return 1 if $self->UNIVERSAL::isa( $class );
}
return 0;
}
 
my $Document = PPI::Document->new( 'subs.pl' );
die "Could not create PDOM!" unless blessed $Document;
 
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# Get all of the subroutine definitions
my @subs =
map { $_->name }
@{ $Document->find(
sub {
$_[1]->isa( 'PPI::Statement::Sub' )
}
) };
say "All sub definitions: @subs";
 
 
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# find the sub calls that use &
# &foo
# &foo()
# \&foo
my @symbols =
map { $_->content =~ s/\A&//r; }
@{ $Document->find(
sub {
$_[1]->isa( 'PPI::Token::Symbol' ) &&
$_[1]->symbol_type eq '&'
}
) || [] };
say "All symbols: @symbols";
 
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# find the sub calls that use parens
# foo()
# foo( @args )
my @list =
map { $_->literal }
@{ $Document->find(
sub {
$_[1]->isa( 'PPI::Token::Word' ) &&
$_[1]->snext_sibling->isa( 'PPI::Structure::List' )
}
) || [] };
say "All list: @list";
 
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# find the sub calls that are barewords
# foo
# foo + bar
# but not
# use vars qw( baz );
# sub quux { ... }
my %reserved = map { $_, $_ } qw( use vars sub my );
my @barewords =
map { $_->literal }
grep {
# Take out the Words that are preceded by 'sub'
# That is, take out the subroutine definitions
# I couldn't get this to work inside the find()
my $previous = $_->previous_sibling;
my $sprevious = $_->sprevious_sibling;
 
! (
blessed( $previous ) &&
blessed( $sprevious ) &&
$previous->isa( 'PPI::Token::Whitespace' ) &&
$sprevious->isa( 'PPI::Token::Word' ) &&
$sprevious->literal eq 'sub'
)
}
@{ $Document->find(
sub {
$_[1]->isa( 'PPI::Token::Word' )
&&
$_[1]->next_sibling->isa( qw(
PPI::Token::Whitespace
PPI::Token::Structure
PPI::Token::List
PPI::Token::Operator
) )
&&
( ! exists $reserved{ $_[1]->literal } )
}
) || [] };
say "All barewords: @barewords";
 
 
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# Combined the used subs
my %used = map { $_ => 1 } ( @symbols, @list, @barewords );
say "All used: @{ [keys %used] }";
 
 
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# The unused have to be the left over ones
my @unused = grep { ! exists $used{$_} } @subs;
say "All unused: @unused";

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.