Find unused "use'd" Perl modules

Question

I am working on a very large, very old "historically grown" codebase. In the past, there were often people thinking "Oh, I may need this and that module, so I just include it...", and later, people often "cached" Data inside of modules ("use ThisAndThat" needing a few seconds to load some hundred MB from DB to RAM, yeah, its really a stupid Idea, we are working on that too) and so, often, we have a small module use'ing like 20 or 30 modules, from who 90% are totally unused in the source itself, and, because of "caching" in several use'd submodules, modules tend to take up one minute to load or even more, which is, of course, not acceptable.

So, Im trying to get that done better. Right now, my way is looking through all the modules, understanding them as much as possible and I look at all the modules including them and see whether they are needed or not.

Is there any easier way? I mean: There are functions returning all subs a module has like

...
return grep { defined &{"$module\::$_"} } keys %{"$module\::"}

, so, aint there any simple way to see which ones are exported by default and which ones come from where and are used in the other modules?

A simple example is Data::Dumper, which is included in nearly every file, even, when all debug-warns and prints and so on arent in the script anymore. But still the module has to load Data::Dumper.

Is there any simple way to check that?

Thanks!

Answer 1

The following code could be part of your solution - it will show you which symbols are imported for each instance of use:

package traceuse;
use strict;
use warnings;
use Devel::Symdump;

sub import {
  my $class = shift;
  my $module = shift;

  my $caller = caller();

  my $before = Devel::Symdump->new($caller);

  my $args = \@_;
  # more robust way of emulating use?
  eval "package $caller; require $module; $module\->import(\@\$args)";

  my $after = Devel::Symdump->new($caller);

  my @added;
  my @after_subs = $after->functions;
  my %before_subs = map { ($_,1) } $before->functions;
  for my $k (@after_subs) {
    push(@added, $k) unless $before_subs{$k};
  }

  if (@added) {
    warn "using module $module added: ".join(' ', @added)."\n";
  } else {
    warn "no new symbols from using module $module\n";
  }
}
1;

Then just replace "use module ..." with "use traceuse module ...", and you'll get a list of the functions that were imported.

Usage example:

package main;

sub foo { print "debug: foo called with: ".Dumper(\@_)."\n"; }

use traceuse Data::Dumper;

This will output:

using module Data::Dumper added: main::Dumper

i.e. you can tell which functions were imported in robust way. And you can easily extend this to report on imported scalar, array and hash variables - check the docs on Devel::Symdump.

Determine which functions are actually used is the other half of the equation. For that you might be able to get away with a simple grep of your source code - i.e. does Dumper appear in the module's source code that's not on a use line. It depends on what you know about your source code.

Notes:

• there may be a module which does what traceuse does - I haven't checked

• there might be a better way to emulate "use" from another package

Answer 2

I kind of got of got it to work with PPI. It looks like this:

#!/usr/local/bin/perl
use strict;
use warnings;

use Data::Dumper;
use Term::ANSIColor;

use PPI;
use PPI::Dumper;

my %doneAlready = ();
$" = ", ";

our $maxDepth = 2;
my $showStuffOtherThanUsedOrNot = 0;

parse("/modules/Test.pm", undef, undef, 0);

sub parse {
        my $file = shift;
        my $indent = shift || 0;
        my $caller = shift || $file;
        my $depth = shift || 0;

        if($depth && $depth >= $maxDepth) {
                return;
        }
        return unless -e $file;
        if(exists($doneAlready{$file}) == 1) {
                return;
        }
        $doneAlready{$file} = 1;
        my $skript = PPI::Document->new($file);

        my @included = ();

        eval {
                foreach my $x (@{$skript->find("PPI::Statement::Include")}) {
                        foreach my $y (@{$x->{children}}) {
                                push @included, $y->{content} if (ref $y eq "PPI::Token::Word" && $y->{content} !~ /^(use|vars|constant|strict|warnings|base|Carp|no)$/);
                        }
                }
        };

        my %double = ();

        print "===== $file".($file ne $caller ? " (Aufgerufen von $caller)" : "")."\n" if $showStuffOtherThanUsedOrNot;
        if($showStuffOtherThanUsedOrNot) {
                foreach my $modul (@included) {
                        next unless -e createFileName($modul);
                        my $is_crap = ((exists($double{$modul})) ? 1 : 0);
                        print "\t" x $indent;
                        print color("blink red") if($is_crap);
                        print $modul;
                        print color("reset") if($is_crap);
                        print "\n";
                        $double{$modul} = 1;
                }
        }

        foreach my $modul (@included) {
                next unless -e createFileName($modul);
                my $anyUsed = 0;
                my $modulDoc = parse(createFileName($modul), $indent + 1, $file, $depth + 1);
                if($modulDoc) {
                        my @exported = getExported($modulDoc);
                        print "Exported: \n" if(scalar @exported && $showStuffOtherThanUsedOrNot);
                        foreach (@exported) {
                                print(("\t" x $indent)."\t");
                                if(callerUsesIt($_, $file)) {
                                        $anyUsed = 1;
                                        print color("green"), "$_, ", color("reset") if $showStuffOtherThanUsedOrNot;
                                } else {
                                        print color("red"), "$_, ", color("reset") if $showStuffOtherThanUsedOrNot;
                                }
                                print "\n" if $showStuffOtherThanUsedOrNot;
                        }

                        print(("\t" x $indent)."\t") if $showStuffOtherThanUsedOrNot;
                        print "Subs: " if $showStuffOtherThanUsedOrNot;
                        foreach my $s (findAllSubs($modulDoc)) {
                                my $isExported = grep($s eq $_, @exported) ? 1 : 0;
                                my $rot = callerUsesIt($s, $caller, $modul, $isExported) ? 0 : 1;
                                $anyUsed = 1 unless $rot;
                                if($showStuffOtherThanUsedOrNot) {
                                        print color("red") if $rot;
                                        print color("green") if !$rot;
                                        print "$s, ";
                                        print color("reset");
                                }
                        }
                        print "\n" if $showStuffOtherThanUsedOrNot;
                        print color("red"), "=========== $modul wahrscheinlich nicht in Benutzung!!!\n", color("reset") unless $anyUsed;
                        print color("green"), "=========== $modul in Benutzung!!!\n", color("reset") if $anyUsed;
                }
        }

        return $skript;
}


sub createFileName {
        my $file = shift;
        $file =~ s#::#/#g;
        $file .= ".pm";
        $file = "/modules/$file";
        return $file;
}

sub getExported {
        my $doc = shift;

        my @exported = ();
        eval {
                foreach my $x (@{$doc->find("PPI::Statement")}) {
                        my $worthATry = 0;
                        my $isMatch = 0;
                        foreach my $y (@{$x->{children}}) {
                                $worthATry = 1 if(ref $y eq "PPI::Token::Symbol");
                                if($y eq '@EXPORT') {
                                        $isMatch = 1;
                                } elsif($isMatch && ref($y) ne "PPI::Token::Whitespace" && ref($y) ne "PPI::Token::Operator" && $y->{content} ne ";") {
                                        push @exported, $y->{content};
                                }
                        }
                }
        };

        my @realExported = ();
        foreach (@exported) {
                eval "\@realExported = $_";
        }

        return @realExported;
}

sub callerUsesIt {
        my $subname = shift;
        my $caller = shift;

        my $namespace = shift || undef;
        my $isExported = shift || 0;

        $caller = `cat $caller`;

        unless($namespace) {
                return 1 if($caller =~ /\b$subname\b/);
        } else {
                $namespace = createPackageName($namespace);
                my $regex = qr#$namespace(?:::|->)$subname#;
                if($caller =~ $regex) {
                        return 1;
                }
        }
        return 0;
}

sub findAllSubs {
        my $doc = shift;

        my @subs = ();

        eval {
                foreach my $x (@{$doc->find("PPI::Statement::Sub")}) {
                        my $foundName = 0;
                        foreach my $y (@{$x->{children}}) {
                                no warnings;
                                if($y->{content} ne "sub" && ref($y) eq "PPI::Token::Word") {
                                        push @subs, $y;
                                }
                                use warnings;
                        }
                }
        };

        return @subs;
}

sub createPackageName {
        my $name = shift;
        $name =~ s#/modules/##g;
        $name =~ s/\.pm$//g;
        $name =~ s/\//::/g;
        return $name;
}

Its really ugly and maybe not 100% working, but it seems, with the tests that Ive done now, that its good for a beginning.