line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Module::Build::Platform::Unix; |
2
|
|
|
|
|
|
|
|
3
|
296
|
|
|
296
|
|
1999
|
use strict; |
|
296
|
|
|
|
|
580
|
|
|
296
|
|
|
|
|
9268
|
|
4
|
296
|
|
|
296
|
|
1623
|
use warnings; |
|
296
|
|
|
|
|
651
|
|
|
296
|
|
|
|
|
17552
|
|
5
|
|
|
|
|
|
|
our $VERSION = '0.42_35'; |
6
|
|
|
|
|
|
|
$VERSION = eval $VERSION; |
7
|
296
|
|
|
296
|
|
1924
|
use Module::Build::Base; |
|
296
|
|
|
|
|
682
|
|
|
296
|
|
|
|
|
98650
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
our @ISA = qw(Module::Build::Base); |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
sub is_executable { |
12
|
|
|
|
|
|
|
# We consider the owner bit to be authoritative on a file, because |
13
|
|
|
|
|
|
|
# -x will always return true if the user is root and *any* |
14
|
|
|
|
|
|
|
# executable bit is set. The -x test seems to try to answer the |
15
|
|
|
|
|
|
|
# question "can I execute this file", but I think we want "is this |
16
|
|
|
|
|
|
|
# file executable". |
17
|
|
|
|
|
|
|
|
18
|
144
|
|
|
144
|
0
|
465
|
my ($self, $file) = @_; |
19
|
144
|
|
|
|
|
2153
|
return +(stat $file)[2] & 0100; |
20
|
|
|
|
|
|
|
} |
21
|
|
|
|
|
|
|
|
22
|
6
|
|
|
6
|
|
46
|
sub _startperl { "#! " . shift()->perl } |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
sub _construct { |
25
|
572
|
|
|
572
|
|
17402
|
my $self = shift()->SUPER::_construct(@_); |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
# perl 5.8.1-RC[1-3] had some broken %Config entries, and |
28
|
|
|
|
|
|
|
# unfortunately Red Hat 9 shipped it like that. Fix 'em up here. |
29
|
558
|
|
|
|
|
2323
|
my $c = $self->{config}; |
30
|
558
|
|
|
|
|
2062
|
for (qw(siteman1 siteman3 vendorman1 vendorman3)) { |
31
|
2232
|
|
33
|
|
|
17312
|
$c->{"install${_}dir"} ||= $c->{"install${_}"}; |
32
|
|
|
|
|
|
|
} |
33
|
|
|
|
|
|
|
|
34
|
558
|
|
|
|
|
4308
|
return $self; |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
# Open group says username should be portable filename characters, |
38
|
|
|
|
|
|
|
# but some Unix OS working with ActiveDirectory wind up with user-names |
39
|
|
|
|
|
|
|
# with back-slashes in the name. The new code below is very liberal |
40
|
|
|
|
|
|
|
# in what it accepts. |
41
|
|
|
|
|
|
|
sub _detildefy { |
42
|
0
|
|
|
0
|
|
|
my ($self, $value) = @_; |
43
|
0
|
|
|
|
|
|
$value =~ s[^~([^/]+)?(?=/|$)] # tilde with optional username |
44
|
|
|
|
|
|
|
[$1 ? |
45
|
0
|
0
|
0
|
|
|
|
(eval{(getpwnam $1)[7]} || "~$1") : |
|
|
|
0
|
|
|
|
|
46
|
|
|
|
|
|
|
($ENV{HOME} || eval{(getpwuid $>)[7]} || glob("~")) |
47
|
0
|
|
|
|
|
|
]ex; |
48
|
|
|
|
|
|
|
return $value; |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
1; |
52
|
|
|
|
|
|
|
__END__ |