package System::Introspector::Probe::LibDirs::Perl;
+
use Moo;
use Module::Metadata;
use Digest::SHA;
+use ExtUtils::Installed;
use System::Introspector::Util qw(
handle_from_command
transform_exceptions
+ output_from_file
);
-use System::Introspector::Logger qw( :log );
+use System::Introspector::Logger qw( :log :dlog );
with 'System::Introspector::Role::Probe';
sub _gather_libdir_info {
my ($self, $libdir) = @_;
- my %module;
- my $pipe = $self->_open_locate_pm_pipe($libdir);
- while (defined( my $line = <$pipe> )) {
- chomp $line;
- my $metadata = Module::Metadata->new_from_file($line);
- next unless $metadata->name;
- my $sha = Digest::SHA->new(256);
- $sha->addfile($line);
- my $version = $metadata->version;
- push @{ $module{ $metadata->name } //= [] }, {
- file => $line,
- version => (
- defined($version)
- ? sprintf('%s', $version)
- : undef
- ),
- size => scalar(-s $line),
- sha256_hex => $sha->hexdigest,
- };
- }
- return \%module;
+ my %modules;
+
+ log_debug { "Gathering Perl libdir info for '$libdir'" };
+
+ my $installed = ExtUtils::Installed->new(inc_override => [ $libdir ]);
+
+ foreach my $module ($installed->modules) {
+ my $packlist = $installed->packlist($module)->packlist_file;
+
+ Dlog_trace { "Packlist file for '$module' in '$libdir' is '$_'" } $packlist;
+
+ if (-f $packlist) {
+ $modules{$module} = [ $installed->files($module, 'all') ];
+ } else {
+ $modules{$module} = undef;
+ }
+ }
+
+ return \%modules;
+
+# my $pipe = $self->_open_locate_pm_pipe($libdir);
+# while (defined( my $line = <$pipe> )) {
+# chomp $line;
+# my $metadata = Module::Metadata->new_from_file($line);
+# next unless $metadata->name;
+# my $sha = Digest::SHA->new(256);
+# $sha->addfile($line);
+# my $version = $metadata->version;
+# push @{ $module{ $metadata->name } //= [] }, {
+# file => $line,
+# version => (
+# defined($version)
+# ? sprintf('%s', $version)
+# : undef
+# ),
+# size => scalar(-s $line),
+# sha256_hex => $sha->hexdigest,
+# };
+# }
+# return \%module;
}
-sub _open_locate_pm_pipe {
- my ($self, $libdir) = @_;
- log_debug { "Executing 'find' to search for Perl module files in '$libdir'" };
- return handle_from_command
- sprintf q{find %s -name '*.pm'}, $libdir;
-}
+#sub _open_locate_pm_pipe {
+# my ($self, $libdir) = @_;
+# log_debug { "Executing 'find' to search for Perl module files in '$libdir'" };
+# return handle_from_command
+# sprintf q{find %s -name '*.pm'}, $libdir;
+#}
+#
+#sub _open_locate_packlist_pipe {
+# my ($self, $libdir) = @_;
+# log_debug { "Executing 'find' to search for Perl module packlist files in '$libdir'" };
+# return handle_from_command
+# sprintf q{find %s -name '.packlist'}, $libdir;
+#}
sub _open_locate_libdirs_pipe {
my ($self) = @_;
unless $root =~ m{/$};
log_debug { "Executing 'locate' to identify Perl 5 library directories" };
return handle_from_command sprintf
+ #lib/perl5 for Local::Lib? - lib/perl for others
q{locate --regex '^%s.*lib/perl5$'}, $root;
+# q{locate --regex '^%s.*lib/perl$'}, $root;
}
1;