Pytanie Znajdź nieużywane "use'd" moduły Perla


Pracuję nad bardzo dużą, bardzo starą "historycznie uprawianą" bazą kodu. W przeszłości często ludzie myśleli: "Och, może potrzebuję tego i tego modułu, więc po prostu to włączam ...", a później ludzie często "buforowali" Dane wewnątrz modułów ("używajcie ThisAndThat" potrzebujących kilku sekund, aby załadować kilkaset MB z DB do RAM, tak, to naprawdę głupi pomysł, nad tym pracujemy), więc często mamy mały moduł wykorzystujący 20 lub 30 modułów, z których 90% całkowicie nieużywane w samym źródle, a ze względu na "buforowanie" w kilku modułach użytkowych moduły zajmują jedną minutę, aby załadować lub nawet więcej, co jest oczywiście nie do zaakceptowania.

Tak, próbuję zrobić to lepiej. W tej chwili, mój sposób patrzenia przez wszystkie moduły, zrozumienie ich jak najwięcej i patrzę na wszystkie moduły w tym i zobaczyć, czy są one potrzebne, czy nie.

Czy istnieje łatwiejszy sposób? Mam na myśli: Istnieją funkcje zwracające wszystkie subkonta, które ma moduł

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

, więc nie istnieje prosty sposób sprawdzenia, które z nich są eksportowane domyślnie, a które pochodzą z miejsca i są używane w innych modułach?

Prostym przykładem jest Data :: Dumper, która jest zawarta w prawie każdym pliku, nawet, gdy wszystkie debugowanie-ostrzeżenia i wydruki i tak dalej nie są w skrypcie. Ale nadal moduł musi załadować Data :: Dumper.

Czy istnieje prosty sposób, aby to sprawdzić?

Dzięki!


12
2017-11-04 14:34


pochodzenie




Odpowiedzi:


Poniższy kod może być częścią twojego rozwiązania - pokaże Ci, które symbole są importowane dla każdego wystąpienia 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;

Następnie zamień "use module ..." na "use traceuse module ...", a otrzymasz listę zaimportowanych funkcji.

Przykład użycia:

package main;

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

use traceuse Data::Dumper;

To wyświetli:

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

tzn. można stwierdzić, które funkcje zostały zaimportowane w solidny sposób. Można go łatwo rozszerzyć, aby raportować zaimportowane zmienne skalarne, tablicowe i hashowe - sprawdź dokumentację Devel::Symdump.

Określ, które funkcje są rzeczywiście używane, to druga połowa równania. W tym celu możesz uciec prostym grepem kodu źródłowego - to znaczy Dumper pojawiają się w kodzie źródłowym modułu, który nie znajduje się na use linia. To zależy od tego, co wiesz o swoim kodzie źródłowym.

Uwagi:

  • może być moduł, który robi to, co robi traceuse - nie sprawdziłem

  • może istnieć lepszy sposób naśladowania "użytkowania" z innego pakietu


6
2017-11-04 16:40



To wygląda całkiem nieźle, ale niestety nie mam żadnych wyników. Skopiowałem to dokładnie, ale w jakiś sposób "import" nie jest wywoływany. Próbowałem w nim umrzeć, ale nie było żadnego rezultatu. Jakąkolwiek wskazówkę co robię źle? - Perik Onti
umieść kod traceuse w swoim własnym pliku - traceuse.pm (zanotuj 1; Właśnie dodałem na końcu); następnie perl -Mtraceuse=Data::Dumper -e1 powinien dać ci trochę wydajności. Czy masz inny plik traceuse.pm? - ErikR
i nie zapomnij zainstalować Devel::Symdump jeśli jeszcze go nie masz. - ErikR
Ahhh, teraz działa. Właśnie zrobiłem "use traceuse Data :: Dumper", które nie zostało załadowane. Ale perl -Mtraceuse = Data :: Dumper działa idealnie. Dzięki, ta funkcja na pewno się przyda. - Perik Onti


W pewnym sensie udało mi się to osiągnąć dzięki PPI. To wygląda tak:

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

To naprawdę brzydkie i może nie w 100% działające, ale wydaje się, że dzięki testom, które już zrobiłem, jest to dobre na początek.


0
2017-11-05 14:55