Найти неиспользуемые модули "use'd" Perl

Ответ 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 - я не проверял

• может быть лучший способ эмулировать "использование" из другого пакета

Ответ 2

Я как-то получил его, чтобы он работал с ИЦП. Это выглядит так:

#!/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% работающий, но, похоже, с тестами, которые Ive сделал сейчас, это хорошо для начала.