Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

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

by stevieb (Canon)
on Oct 15, 2018 at 17:19 UTC ( [id://1224050]=note: print w/replies, xml ) Need Help??


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;

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

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

      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

      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

      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

      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.

        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 // "";

        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

        Enjoy, Have FUN! H.Merijn

        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.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://1224050]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others lurking in the Monastery: (5)
As of 2024-04-25 19:59 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found