/
FindPerl.pm
128 lines (98 loc) · 4.08 KB
/
FindPerl.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
package Devel::FindPerl;
use strict;
use warnings;
use Exporter 5.57 'import';
our @EXPORT_OK = qw/find_perl_interpreter/;
use Carp;
use Cwd;
use ExtUtils::Config;
use File::Spec;
sub find_perl_interpreter {
my $config = shift || ExtUtils::Config->new;
my $perl = $^X;
return VMS::Filespec::vmsify($perl) if $^O eq 'VMS';
my $perl_basename = File::Basename::basename($perl);
my @potential_perls;
# Try 1, Check $^X for absolute path
push @potential_perls, $perl if File::Spec->file_name_is_absolute($perl);
# Try 2, Check $^X for a valid relative path
my $abs_perl = File::Spec->rel2abs($perl);
push @potential_perls, $abs_perl;
# Try 3, Last ditch effort: These two option use hackery to try to locate
# a suitable perl. The hack varies depending on whether we are running
# from an installed perl or an uninstalled perl in the perl source dist.
if ($ENV{PERL_CORE}) {
# Try 3.A, If we are in a perl source tree, running an uninstalled
# perl, we can keep moving up the directory tree until we find our
# binary. We wouldn't do this under any other circumstances.
my $perl_src = Cwd::realpath(_perl_src());
if (defined($perl_src) && length($perl_src)) {
my $uninstperl = File::Spec->rel2abs(File::Spec->catfile($perl_src, $perl_basename));
push @potential_perls, $uninstperl;
}
}
else {
# Try 3.B, First look in $Config{perlpath}, then search the user's
# PATH. We do not want to do either if we are running from an
# uninstalled perl in a perl source tree.
push @potential_perls, $config->get('perlpath');
push @potential_perls, map { File::Spec->catfile($_, $perl_basename) } File::Spec->path();
}
# Now that we've enumerated the potential perls, it's time to test
# them to see if any of them match our configuration, returning the
# absolute path of the first successful match.
my $exe = $config->get('exe_ext');
foreach my $thisperl (@potential_perls) {
$thisperl .= $exe if length $exe and $thisperl !~ m/$exe$/i;
return $thisperl if -f $thisperl && _perl_is_same($thisperl);
}
# We've tried all alternatives, and didn't find a perl that matches
# our configuration. Throw an exception, and list alternatives we tried.
my @paths = map File::Basename::dirname($_), @potential_perls;
die "Can't locate the perl binary used to run this script in (@paths)\n";
}
# if building perl, perl's main source directory
sub _perl_src {
# N.B. makemaker actually searches regardless of PERL_CORE, but
# only squawks at not finding it if PERL_CORE is set
return unless $ENV{PERL_CORE};
my $updir = File::Spec->updir;
my $dir = File::Spec->curdir;
# Try up to 10 levels upwards
for (0..10) {
if (
-f File::Spec->catfile($dir,"config_h.SH")
&&
-f File::Spec->catfile($dir,"perl.h")
&&
-f File::Spec->catfile($dir,"lib","Exporter.pm")
) {
return Cwd::realpath( $dir );
}
$dir = File::Spec->catdir($dir, $updir);
}
carp "PERL_CORE is set but I can't find your perl source!\n";
return; # return empty string if $ENV{PERL_CORE} but can't find dir ???
}
sub _perl_is_same {
my $perl = shift;
my @cmd = $perl;
# When run from the perl core, @INC will include the directories
# where perl is yet to be installed. We need to reference the
# absolute path within the source distribution where it can find
# it's Config.pm This also prevents us from picking up a Config.pm
# from a different configuration that happens to be already
# installed in @INC.
push @cmd, '-I' . File::Spec->catdir(File::Basename::dirname($perl), 'lib') if $ENV{PERL_CORE};
push @cmd, qw(-MConfig=myconfig -e print -e myconfig);
open my $fh, '-|', @cmd or return;
my $myconfig = join '', <$fh>;
close $fh or return;
return $myconfig eq Config->myconfig;
}
1;
#ABSTRACT: Find the path to your perl
=head1 DESCRIPTION
This module tries to find the path to the currently running perl.
=func find_perl_interpreter
This function will try really really hard to find the path to the perl running your program. I should be able to find it in most circumstances. Do note that the result of this function is not cached, as it might be invalidated by for example a change of directory.