Commit | Line | Data |
afd7c030 |
1 | package System::Introspector::Probe::LibDirs::Perl; |
f356dcb0 |
2 | use Moo; |
3 | use Module::Metadata; |
4 | use Digest::SHA; |
5 | |
ff854047 |
6 | use System::Introspector::Util qw( |
7 | handle_from_command |
8 | transform_exceptions |
9 | ); |
10 | |
f356dcb0 |
11 | has root => ( |
12 | is => 'ro', |
13 | default => sub { '/' }, |
14 | ); |
15 | |
16 | sub gather { |
17 | my ($self) = @_; |
ff854047 |
18 | return transform_exceptions { |
19 | my $pipe = $self->_open_locate_libdirs_pipe; |
20 | my %libdir; |
21 | while (defined( my $line = <$pipe> )) { |
22 | chomp $line; |
23 | $libdir{ $line } = transform_exceptions { |
24 | return { modules => $self->_gather_libdir_info($line) }; |
25 | }; |
26 | } |
27 | return { libdirs_perl => \%libdir }; |
28 | }; |
f356dcb0 |
29 | } |
30 | |
31 | sub _gather_libdir_info { |
32 | my ($self, $libdir) = @_; |
33 | my %module; |
34 | my $pipe = $self->_open_locate_pm_pipe($libdir); |
35 | while (defined( my $line = <$pipe> )) { |
36 | chomp $line; |
37 | my $metadata = Module::Metadata->new_from_file($line); |
38 | next unless $metadata->name; |
39 | my $sha = Digest::SHA->new(256); |
40 | $sha->addfile($line); |
474bd454 |
41 | my $version = $metadata->version; |
f356dcb0 |
42 | push @{ $module{ $metadata->name } //= [] }, { |
43 | file => $line, |
474bd454 |
44 | version => ( |
45 | defined($version) |
46 | ? sprintf('%s', $version) |
47 | : undef |
48 | ), |
f356dcb0 |
49 | size => scalar(-s $line), |
50 | sha256_hex => $sha->hexdigest, |
51 | }; |
52 | } |
53 | return \%module; |
54 | } |
55 | |
56 | sub _open_locate_pm_pipe { |
57 | my ($self, $libdir) = @_; |
ff854047 |
58 | return handle_from_command |
59 | sprintf q{find %s -name '*.pm'}, $libdir; |
f356dcb0 |
60 | } |
61 | |
62 | sub _open_locate_libdirs_pipe { |
63 | my ($self) = @_; |
64 | my $root = $self->root; |
65 | $root .= '/' |
66 | unless $root =~ m{/$}; |
ff854047 |
67 | return handle_from_command sprintf |
68 | q{locate --regex '^%s.*lib/perl5$'}, $root; |
f356dcb0 |
69 | } |
70 | |
71 | 1; |
535e84b6 |
72 | |
73 | __END__ |
74 | |
75 | =head1 NAME |
76 | |
77 | System::Introspector::LibDirs::Perl - Gather perl lib directory data |
78 | |
79 | =head1 DESCRIPTION |
80 | |
81 | Finds locations that look like L<local::lib> or comparable Perl library |
82 | directories, and extracts module information from them. |
83 | |
84 | =head1 ATTRIBUTES |
85 | |
86 | =head2 root |
87 | |
88 | This is the root path to be searched for library directories. Defaults |
89 | to C</>. |
90 | |
91 | =head1 SEE ALSO |
92 | |
93 | =over |
94 | |
95 | =item L<System::Introspector> |
96 | |
97 | =back |
98 | |
99 | =cut |
100 | |