in reply to Re^4: CPAN modules for inspecting a Perl distribution?
in thread CPAN modules for inspecting a Perl distribution?

Hey there Tux,

I'll gladly try to repro, but the link you specified throws: "The requested URL was not found on this server.".

Could you paste the code here, or correct the link?

Thanks,

-stevieb

  • Comment on Re^5: CPAN modules for inspecting a Perl distribution?

Replies are listed 'Best First'.
Re^6: CPAN modules for inspecting a Perl distribution?
by stevieb (Canon) on Oct 15, 2018 at 20:59 UTC

    I didn't notice that Tux actually Private Messaged me with a working link. I only noticed it after another astute Monk pointed out there was a tag missing in the link.

    Here's a working link to the code: https://tux.nl/Files/examine-subs.pl.

    Here, inline is the actual code, just in case. I'll now go in pursuit of figuring out where the issue may lie. Hopefully it isn't within my code, but if it is, I'm always good at acknowledging and accepting mistakes. If the issue isn't in my code, I will do my best as always to find out what the issue is, and assign a ticket or contact whoever is responsible nonetheless :)

    #!/pro/bin/perl

use 5.18.2;
use warnings;

our $VERSION = "0.02 - 20181015";
our $CMD = $0 =~ s{.*/}{}r;

sub usage {
    my $err = shift and select STDERR;
    say "usage: $CMD [-v] [file|folder] ...";
    say "       $CMD --core | --site";
    exit $err;
    } # usage

use Getopt::Long qw(:config bundling);
GetOptions (
    "help|?"        => sub { usage (0); },
    "V|version"        => sub { say "$CMD [$VERSION]"; exit 0; },

    "c|core!"        => \ my $opt_c,
    "s|site!"        => \ my $opt_s,

    "v|verbose:1"    => \(my $opt_v = 0),
    ) or usage (1);

use Config;
use Cwd;
use Data::Peek;
use Devel::Examine::Subs;
use Digest::SHA qw(sha256_hex);
use File::Find;
use SourceCode::LineCounter::Perl;
use String::CommonPrefix qw(common_prefix);

my @loc = @ARGV;
$opt_c and push @loc, $Config{privlib};
$opt_s and push @loc, $Config{sitelib};
@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 (hard-link)
    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) {
    $opt_v and say $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}, $_->{b
+lank},
    $_->{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]
[reply]
[d/l]

      To get things rolling on a Linux Mint 18., I had to:

      cpanm Data::Peek
cpanm SourceCode::LineCounter::Perl
cpanm String::CommonPrefix

      [download]

      OS details (cat /etc/linuxmint/info):

      RELEASE=18.3
CODENAME=sylvia
EDITION="Cinnamon 64-bit"
DESCRIPTION="Linux Mint 18.3 Sylvia"
DESKTOP=Gnome
TOOLKIT=GTK
NEW_FEATURES_URL=http://www.linuxmint.com/rel_sylvia_cinnamon_whatsnew
+.php
RELEASE_NOTES_URL=http://www.linuxmint.com/rel_sylvia_cinnamon.php
USER_GUIDE_URL=help:linuxmint
GRUB_TITLE=Linux Mint 18.3 Cinnamon 64-bit

      [download]

      I ran the script, and within two seconds (literally), returned:

      spek@scelia ~/scratch $ perl des_problem.pl
File Eval.pm has no objects
File a.pl has no objects
File arr.pl has no objects
File bit.pl has no objects
File coerce.pl has no objects
File col.pl has no objects
File complex_structure_c_to_perl/script.pl has no objects
File eval.pl has no objects
File fc.pl has no objects
File fork.pl has no objects
File inline.pl has no objects
File ip.pl has no objects
File json.pl has no objects
File last.pl has no objects
File line.pl has no objects
File mcpan.pl has no objects
File mcpan_default.pl has no objects
File oct.pl has no objects
File open.pl has no objects
File ppi.pl has no objects
File rad.pl has no objects
File rcopy.pl has no objects
File re.pl has no objects
File step/step.pl has no objects
File sub.pl has no objects
File tern.pl has no objects
File test.pl has no objects
File y.pl has no objects
 subs   lines     LOC    doc  blank  File
----- ------- ------- ------ ------  ---------------------------------
+-----
    9     143      94      0     27  step/Step.pm
    4      57      23      2     13  tk.pl
    3      29      12      1      9  point.pl
    2      25      13      0      5  store.pl
    2      26       8      0      5  blah.pl
    2      15       6      0      4  Test.pm
    1      23       8      0      3  x.pl
    1      16       6      0      5  choose.pl
    1     122       6      7     18  des_problem.pl
    1      23       4      2      7  mock.pl
    1      12       3      0      4  foo.pl
    0      20       0      0      6  fork.pl
    0      14       0      0      5  json.pl
    0      29       0      0      6  rad.pl
    0      17       0      0      5  mcpan_default.pl
    0      13       0      0      3  ppi.pl
    0       8       0      0      3  test.pl
    0      10       0      0      5  rcopy.pl
    0      25       0      0      5  a.pl
    0       9       0      0      3  tern.pl
    0      12       0      0      3  open.pl
    0      38       0      0     21  inline.pl
    0      10       0      0      2  line.pl
    0      38       0      0      7  sub.pl
    0      33       0      3      9  y.pl
    0      15       0      0      5  complex_structure_c_to_perl/scrip
+t.pl
    0      15       0      0      2  coerce.pl
    0      17       0      6      6  fc.pl
    0       9       0      0      2  oct.pl
    0      40       0      1      6  col.pl
    0      13       0      0      5  eval.pl
    0      11       0      0      3  step/step.pl
    0      24       0      0      4  arr.pl
    0       8       0      0      2  Eval.pm
    0      20       0      0      6  mcpan.pl
    0      18       0      2      5  re.pl
    0      16       0      0      3  last.pl
    0      18       0      0      5  ip.pl
    0      16       0      0      6  bit.pl
----- ------- ------- ------ ------  ---------------------------------
+-----
   27    1007     183     24    243

      [download]

      I then proceeded to install everything all the same on one of my development ARM-based Raspberry Pi devices, a base one, only with perlbrew (not even Devel::Examine::Subs was installed), and notice a fault in another one of my dists File::Edit::Portable happen when running the script:

      File perl5/perlbrew/build/perl-5.24.4/perl-5.24.4/cpan/Module-Load-Con
+ditional/t/to_load/LoadIt.pm has no objects
Use of uninitialized value $sep in unpack at /home/pi/perl5/perlbrew/p
+erls/perl-5.24.4/lib/site_perl/5.24.4/File/Edit/Portable.pm line 414.
 at /home/pi/perl5/perlbrew/perls/perl-5.24.4/lib/site_perl/5.24.4/Fil
+e/Edit/Portable.pm line 6.
    File::Edit::Portable::__ANON__("Use of uninitialized value \$sep i
+n unpack at /home/pi/perl5/p"...) called at /home/pi/perl5/perlbrew/p
+erls/perl-5.24.4/lib/site_perl/5.24.4/File/Edit/Portable.pm line 414
    File::Edit::Portable::_convert_recsep(File::Edit::Portable=HASH(0x
+e89758), undef, "hex") called at /home/pi/perl5/perlbrew/perls/perl-5
+.24.4/lib/site_perl/5.24.4/File/Edit/Portable.pm line 288
    File::Edit::Portable::recsep(File::Edit::Portable=HASH(0xe89758), 
+"/home/pi/perl5/perlbrew/build/perl-5.24.4/perl-5.24.4/cpan/Mo"..., "
+hex") called at /home/pi/perl5/perlbrew/perls/perl-5.24.4/lib/site_pe
+rl/5.24.4/Devel/Examine/Subs.pm line 748
    Devel::Examine::Subs::_read_file(Devel::Examine::Subs=HASH(0x1bfdb
+b0), HASH(0x17f5768)) called at /home/pi/perl5/perlbrew/perls/perl-5.
+24.4/lib/site_perl/5.24.4/Devel/Examine/Subs.pm line 886
    Devel::Examine::Subs::_core(Devel::Examine::Subs=HASH(0x1bfdbb0)) 
+called at /home/pi/perl5/perlbrew/perls/perl-5.24.4/lib/site_perl/5.2
+4.4/Devel/Examine/Subs.pm line 437
    Devel::Examine::Subs::run(Devel::Examine::Subs=HASH(0x1bfdbb0), HA
+SH(0x1159368)) called at /home/pi/perl5/perlbrew/perls/perl-5.24.4/li
+b/site_perl/5.24.4/Devel/Examine/Subs.pm line 155
    Devel::Examine::Subs::objects(Devel::Examine::Subs=HASH(0x1bfdbb0)
+) called at des_error.pl line 79

      [download]

      I'll investigate further. There are a couple of recent issues brought up to me that may be affecting things, but I've had a difficult time solidifying the cause. I believe some may be related to problems in File::Edit::Portable, but am not 100% sure. Not all breakage happens at the same place.

      I'll keep testing, and throwing things at my internal test platforms until I understand the issue(s).

      I'm currently running commands to automate against a couple of Windows machines and Unix computers I've got set up for such an arrangement. I apologize if my software doesn't work as advertised.

[reply]
[d/l]
[select]

        You did not pass --site, which will analyze the current folder. --site will analyze perl5's site_perl. In my perl-5.28.0 I have 2118 modules installed, resulting in 12151 .pm files and 900 .pl files with a total of over 5 million lines. That'll take a while to complete.

        I Forgot to mention that I also ran into that File::Edit::Portable issue, and I changed that line to

            $sep = unpack "H*", $sep // "";

        [download]

        just to see how far I could get.

        $ find site_perl/5.28.0 -name \*.pm | wc -l
11735

$ find site_perl/5.28.0 -name \*.pl | wc -l
900

$ find site_perl/5.28.0 -name \*.p[lm] | xargs cat | wc -l
5246249

$ perl -nE'/^=head2.*L<(.*?)\|/ and$x{$1}++;END{say scalar keys %x}' 5
+.28.0/x86_64-linux-thread-multi-ld/perllocal.pod
1483

        [download]

        Enjoy, Have FUN! H.Merijn
[reply]
[d/l]
[select]

        I may be wrong here. Might be that I had RELEASE_TESTING=1 enabled, breaking installs where that directive is only for developer testing.

        ...if that's my mistake, it's one I'm sure all authors have made in the past. If not, I'm a truthful person when it comes to code. We will see, and I have the diligence to get to the bottom of it.

[reply]
[d/l]

In Section Seekers of Perl Wisdom