#!/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;
[download]