查找未使用的“已使用”Perl 模块

Question

我正在研究一个非常庞大、非常古老的“历史悠久”的代码库。过去经常有人想“哦，我可能需要这个那个模块，所以我只包含它......”，后来人们经常“缓存”模块内部的数据（“使用ThisAndThat”需要几个几秒钟就可以将数百 MB 从 DB 加载到 RAM，是的，这真是一个愚蠢的想法，我们也在努力）所以，我们经常有一个小模块使用 20 或 30 个模块，其中 90% 是在源本身中完全未使用，并且由于在几个使用的子模块中“缓存”，模块往往需要一分钟甚至更多时间来加载，这当然是不可接受的。

所以，我想把它做得更好。现在，我的方式是浏览所有模块，尽可能多地了解它们，然后查看包括它们在内的所有模块，看看是否需要它们。

有没有更简单的方法？我的意思是：有些函数会返回一个模块的所有子类

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

，那么，没有什么简单的方法可以查看哪些是默认导出的，哪些是从哪里来的，哪些是在其他模块中使用的？

一个简单的例子是 Data::Dumper，它几乎包含在每个文件中，甚至当所有调试警告和打印等不再在脚本中时。但是模块仍然必须加载 Data::Dumper。

有什么简单的方法可以检查吗？

谢谢！

Answer 1

以下代码可能是您解决方案的一部分 - 它会显示为 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;

然后只需将“use module ...”替换为“use traceuse module ...”，您将获得已导入函数的列表。

使用示例：

package main;

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

use traceuse Data::Dumper;

这将输出：

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

即您可以分辨出哪些函数是以稳健的方式导入的。您可以轻松扩展它以报告导入的标量、数组和散列变量 - 查看Devel::Symdump 上的文档。

确定实际使用哪些函数是等式的另一半。为此，您可能可以通过源代码的简单 grep 来逃脱 - 即 Dumper 是否出现在模块的源代码中，而不是在 use 行上。这取决于您对源代码的了解程度。

注意事项：

• 可能有一个模块可以完成 traceuse 的工作 - 我还没有检查过

• 可能有更好的方法来模拟另一个包中的“使用”

Answer 2

我有点让它与 PPI 一起工作。它看起来像这样：

#!/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;
}

它真的很丑，而且可能不是 100% 有效，但似乎，根据我现在所做的测试，它对一个开始很有好处。