14

私は非常に大規模で非常に古い「歴史的に成長した」コードベースに取り組んでいます。以前は、「ああ、これとあのモジュールが必要かもしれないので、それを含めるだけ...」と考えている人がよくいました。 DB から RAM に数百 MB をロードするのに数秒かかります。ええ、それは本当にばかげたアイデアです。私たちもそれに取り組んでいます)。ソース自体ではまったく使用されておらず、使用されているいくつかのサブモジュールで「キャッシュ」されているため、モジュールのロードに 1 分またはそれ以上かかる傾向があり、これはもちろん受け入れられません。

だから、私はそれをより良くしようとしています。現在、私のやり方は、すべてのモジュールに目を通し、それらを可能な限り理解し、それらを含むすべてのモジュールを見て、それらが必要かどうかを確認することです。

もっと簡単な方法はありますか？つまり、モジュールが持つすべてのサブルーチンを返す関数があります

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

、それで、どれがデフォルトでエクスポートされ、どれがどこから来て、他のモジュールで使用されているかを確認する簡単な方法はありませんか?

簡単な例は Data::Dumper で、これはほぼすべてのファイルに含まれています。これは、すべてのデバッグ警告や出力などがスクリプトに含まれなくなった場合でも同様です。それでも、モジュールは Data::Dumper をロードする必要があります。

それを確認する簡単な方法はありますか？

ありがとう！

4

2 に答える 2

7

次のコードは、ソリューションの一部である可能性があります。これにより、 の各インスタンスに対してインポートされるシンボルが表示されます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 が行うことを行うモジュールがあるかもしれません - 私はチェックしていません

  • 別のパッケージから「使用」をエミュレートするより良い方法があるかもしれません

于 2012-11-04T16:40:43.510 に答える
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% は機能していませんが、私が今行ったテストでは、最初は良いようです。

于 2012-11-05T14:55:31.067 に答える