Commit | Line | Data |
820f978f |
1 | package System::Introspector::Probe::Perls; |
2 | use Moo; |
3 | |
4 | use System::Introspector::Util qw( |
5 | transform_exceptions |
6 | handle_from_command |
7 | fail |
8 | ); |
9 | |
10 | has root => ( |
11 | is => 'ro', |
12 | default => sub { '/' }, |
13 | ); |
14 | |
15 | sub gather { |
16 | my ($self) = @_; |
17 | return transform_exceptions { |
18 | my @configs = $self->_find_possible_perl_configs; |
19 | my %found; |
9bd83260 |
20 | my %seen; |
820f978f |
21 | for my $config (@configs) { |
22 | my $info = transform_exceptions { |
23 | return $self->_gather_info($config); |
24 | }; |
9bd83260 |
25 | next if $info->{config}{sitelibexp} |
26 | and $seen{$info->{config}{sitelibexp}}++; |
820f978f |
27 | $found{$config} = $info |
28 | if defined $info; |
29 | } |
30 | return { perls => \%found }; |
31 | }; |
32 | } |
33 | |
34 | sub _gather_info { |
35 | my ($self, $config) = @_; |
36 | open my $fh, '<', $config |
37 | or fail "Unable to determine '$config': $!"; |
38 | my $first_line = <$fh>; |
39 | return undef |
40 | unless defined $first_line and $first_line =~ m{^#.+configpm}; |
41 | my %info; |
42 | my $is_info; |
43 | LINE: |
44 | while (defined( my $line = <$fh> )) { |
45 | if ($line =~ m{tie\s+\%Config}) { |
46 | $is_info++; |
47 | next LINE; |
48 | } |
49 | chomp $line; |
50 | if ($line =~ m{^\s*([a-z0-9_]+)\s*=>\s*'(.*)',\s*$}i) { |
51 | $info{$1} = $2; |
52 | } |
53 | elsif ($line =~ m{^\s*([a-z0-9_]+)\s*=>\s*undef,$}i) { |
54 | $info{$1} = undef; |
55 | } |
56 | } |
57 | return { |
58 | (defined $info{scriptdir} and $info{version}) |
59 | ? (executable => join('/', $info{scriptdir}, 'perl' . $info{version})) |
60 | : (), |
61 | config => \%info, |
62 | }; |
63 | } |
64 | |
65 | sub _find_possible_perl_configs { |
66 | my ($self) = @_; |
67 | (my $root = $self->root) =~ s{/$}{}; |
68 | my $handle = handle_from_command sprintf |
69 | q{locate --regex '^%s/.*/Config.pm$'}, $root; |
70 | my @lines = <$handle>; |
71 | chomp @lines; |
72 | return @lines; |
73 | } |
74 | |
75 | 1; |