Note that there are some explanatory texts on larger screens.

plurals
  1. PO
    primarykey
    data
    text
    <p>I kind of got of got it to work with PPI. It looks like this:</p> <pre><code>#!/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 &amp;&amp; $depth &gt;= $maxDepth) { return; } return unless -e $file; if(exists($doneAlready{$file}) == 1) { return; } $doneAlready{$file} = 1; my $skript = PPI::Document-&gt;new($file); my @included = (); eval { foreach my $x (@{$skript-&gt;find("PPI::Statement::Include")}) { foreach my $y (@{$x-&gt;{children}}) { push @included, $y-&gt;{content} if (ref $y eq "PPI::Token::Word" &amp;&amp; $y-&gt;{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 &amp;&amp; $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-&gt;find("PPI::Statement")}) { my $worthATry = 0; my $isMatch = 0; foreach my $y (@{$x-&gt;{children}}) { $worthATry = 1 if(ref $y eq "PPI::Token::Symbol"); if($y eq '@EXPORT') { $isMatch = 1; } elsif($isMatch &amp;&amp; ref($y) ne "PPI::Token::Whitespace" &amp;&amp; ref($y) ne "PPI::Token::Operator" &amp;&amp; $y-&gt;{content} ne ";") { push @exported, $y-&gt;{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(?:::|-&gt;)$subname#; if($caller =~ $regex) { return 1; } } return 0; } sub findAllSubs { my $doc = shift; my @subs = (); eval { foreach my $x (@{$doc-&gt;find("PPI::Statement::Sub")}) { my $foundName = 0; foreach my $y (@{$x-&gt;{children}}) { no warnings; if($y-&gt;{content} ne "sub" &amp;&amp; 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; } </code></pre> <p>Its really ugly and maybe not 100% working, but it seems, with the tests that Ive done now, that its good for a beginning. </p>
    singulars
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    plurals
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    1. This table or related slice is empty.
 

Querying!

 
Guidance

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload