I like your approach, but it gave me a lot of doubles and it took ages. Here's my stab at it
#!/usr/bin/env perl
use 5.18.2;
use warnings;
use Digest::SHA qw(sha256_hex);
use Devel::Examine::Subs;
use SourceCode::LineCounter::Perl;
use String::CommonPrefix qw(common_prefix);
use Data::Peek;
use File::Find;
use Cwd;
my @loc = @ARGV;
@loc or @loc = (getcwd);
my %file;
my %seen;
# Find all .pm and .pl files. (no .PL or .xs)
find (sub {
m/\.p[ml]$/ or return;
m/^\./ || -l and return; # No symlinks or dot-files
$File::Find::dir =~ m{\b(?:sandbox|tmp)(?:/|$)} and return;
$seen{(lstat)[1]}++ and return; # dup on inode
my $sha = sha256_hex ($_);
$seen{$sha}++ and return; # dup on SHA
$file{$File::Find::name} = $sha;
}, @loc);
my $pfx = common_prefix (keys %file);
my %stats;
for my $file (sort keys %file) {
my $name = $file =~ s/^$pfx//r;
my $flc = SourceCode::LineCounter::Perl->new;
$flc->count ($file);
$stats{$name} = {
name => $name,
file => $file,
lines => $flc->total,
blank => $flc->blank,
doc => $flc->documentation,
cmnt => $flc->comment,
loc => 0,
nobj => 0,
};
# Now analyse subs
my $des = Devel::Examine::Subs->new (file => $file);
unless ($des) {
say STDERR "Cannot analyse $name";
next;
}
my $objs = $des->objects;
unless ($objs) {
say STDERR "File $name has no objects";
next;
}
foreach my $obj (@{$des->objects}) {
$stats{$name}{nobj}++;
my $slc = SourceCode::LineCounter::Perl->new;
$slc->count (\do { join "\n" => @{$obj->code} });
my $loc = $slc->code;
$stats{$name}{loc} += $loc;
push @{$stats{$name}{obj}}, {
name => $obj->name,
loc => $loc,
lines => $slc->documentation,
cmnt => $slc->comment,
blnk => $slc->blank,
doc => $slc->documentation,
};
}
}
delete $SIG{__WARN__};
delete $SIG{__DIE__};
my @sum;
say " subs lines LOC doc blank File";
say "----- ------- ------- ------ ------ ----------------------------
+----------";
for (sort { $b->{nobj} <=> $a->{nobj} || $b->{loc} <=> $a->{loc} } val
+ues %stats) {
printf "%5d %7d %7d %6s %6d %s\n",
$_->{nobj}, $_->{lines}, $_->{loc}, $_->{doc} + $_->{cmnt}, $_
+->{blank},
$_->{name};
$sum[0] += $_->{nobj};
$sum[1] += $_->{lines};
$sum[2] += $_->{loc};
$sum[3] += $_->{doc} + $_->{cmnt};
$sum[4] += $_->{blank};
}
say "----- ------- ------- ------ ------ ----------------------------
+----------";
printf "%5d %7d %7d %6s %6d\n", @sum;
Thanks for the motivation :)
Enjoy, Have FUN! H.Merijn