查找未使用的“use'd”Perl模块

Question

我正在研究一个非常庞大，非常古老的“历史增长”代码库。过去，人们常常会想：“噢，我可能需要这个和那个模块，所以我只是把它包括......”，后来人们经常会在模块中“缓存”数据（“使用ThisAndThat”需要一些几秒钟从数据库加载一百MB到RAM，是的，它真的是一个愚蠢的想法，我们也在研究这个），所以，我们经常有一个小模块使用像20或30个模块，90％是谁在源代码本身中完全没有使用，并且由于在几个使用的子模块中“缓存”，所以模块往往需要一分钟才能加载，甚至更多，这当然是不可接受的。

所以，我试图让它做得更好。现在，我的方法是查看所有模块，尽可能多地理解它们，并查看所有模块，包括它们，看看它们是否需要。

有没有更简单的方法？我的意思是：有有返回所有潜艇模块具有的功能，如

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

，因此，AINT没有简单的方法，看看哪些是默认出口，哪些来自哪里，并在其他模块中使用？

一个简单的例子是数据::自卸车，它包含在几乎每一个文件，甚至，当所有调试警告和版画等脚本ARENT了。但模块仍然需要加载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; 

然后只要将“使用模块...”与“使用traceuse模块...“，你会得到一个导入的函数列表。

用例：

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％的工作，但现在看来，与香港专业教育学院现在所做的测试中，它的很好的一个开端。