File Coverage

blib/lib/Module/Build/Platform/Unix.pm
Criterion Covered Total %
statement 17 21 80.9
branch 0 2 0.0
condition 1 9 11.1
subroutine 6 7 85.7
pod 0 1 0.0
total 24 40 60.0


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__