line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Module::Build::Platform::Unix; |
2
|
|
|
|
|
|
|
|
3
|
293
|
|
|
293
|
|
2109
|
use strict; |
|
293
|
|
|
|
|
607
|
|
|
293
|
|
|
|
|
9660
|
|
4
|
293
|
|
|
293
|
|
1832
|
use warnings; |
|
293
|
|
|
|
|
2702
|
|
|
293
|
|
|
|
|
19892
|
|
5
|
|
|
|
|
|
|
our $VERSION = '0.42_33'; |
6
|
|
|
|
|
|
|
$VERSION = eval $VERSION; |
7
|
293
|
|
|
293
|
|
1981
|
use Module::Build::Base; |
|
293
|
|
|
|
|
590
|
|
|
293
|
|
|
|
|
107332
|
|
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
|
535
|
my ($self, $file) = @_; |
19
|
144
|
|
|
|
|
2455
|
return +(stat $file)[2] & 0100; |
20
|
|
|
|
|
|
|
} |
21
|
|
|
|
|
|
|
|
22
|
6
|
|
|
6
|
|
53
|
sub _startperl { "#! " . shift()->perl } |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
sub _construct { |
25
|
560
|
|
|
560
|
|
16889
|
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
|
546
|
|
|
|
|
3379
|
my $c = $self->{config}; |
30
|
546
|
|
|
|
|
2436
|
for (qw(siteman1 siteman3 vendorman1 vendorman3)) { |
31
|
2184
|
|
33
|
|
|
23289
|
$c->{"install${_}dir"} ||= $c->{"install${_}"}; |
32
|
|
|
|
|
|
|
} |
33
|
|
|
|
|
|
|
|
34
|
546
|
|
|
|
|
5866
|
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__ |