File Coverage

blib/lib/ExtUtils/Helpers/Unix.pm
Criterion Covered Total %
statement 35 35 100.0
branch 10 16 62.5
condition 1 3 33.3
subroutine 7 7 100.0
pod 0 2 0.0
total 53 63 84.1


line stmt bran cond sub pod time code
1             package ExtUtils::Helpers::Unix;
2             $ExtUtils::Helpers::Unix::VERSION = '0.024'; # TRIAL
3 4     4   13 use strict;
  4         4  
  4         108  
4 4     4   12 use warnings FATAL => 'all';
  4         4  
  4         122  
5              
6 4     4   13 use Exporter 5.57 'import';
  4         50  
  4         154  
7             our @EXPORT = qw/make_executable detildefy/;
8              
9 4     4   15 use Carp qw/croak/;
  4         4  
  4         163  
10 4     4   13 use Config;
  4         4  
  4         1317  
11              
12             my $layer = $] >= 5.008001 ? ":raw" : "";
13              
14             sub make_executable {
15 1     1 0 131 my $filename = shift;
16 1         9 my $current_mode = (stat $filename)[2] + 0;
17 1 50       21 if (-T $filename) {
18 1         18 open my $fh, "<$layer", $filename;
19 1         8 my @lines = <$fh>;
20 1 50 33     81 if (@lines and $lines[0] =~ s{ \A \#! \s* (?:/\S+/)? perl \b (.*) \z }{$Config{startperl}$1}xms) {
21 1 50       51 open my $out, ">$layer", "$filename.new" or croak "Couldn't open $filename.new: $!";
22 1         9 print $out @lines;
23 1         19 close $out;
24 1 50       41 rename $filename, "$filename.bak" or croak "Couldn't rename $filename to $filename.bak";
25 1 50       19 rename "$filename.new", $filename or croak "Couldn't rename $filename.new to $filename";
26 1         56 unlink "$filename.bak";
27             }
28             }
29 1         18 chmod $current_mode | oct(111), $filename;
30 1         3 return;
31             }
32              
33             sub detildefy {
34 9     9 0 813 my $value = shift;
35             # tilde with optional username
36 9         16 for ($value) {
37 9 50       45 s{ ^ ~ (?= /|$)} [ $ENV{HOME} || (getpwuid $>)[7] ]ex or # tilde without user name
  5 100       27  
38 3 100       622 s{ ^ ~ ([^/]+) (?= /|$) } { (getpwnam $1)[7] || "~$1" }ex; # tilde with user name
39             }
40 9         47 return $value;
41             }
42              
43             1;
44              
45             # ABSTRACT: Unix specific helper bits
46              
47             __END__