File Coverage

blib/lib/ExtUtils/Helpers/Unix.pm
Criterion Covered Total %
statement 43 43 100.0
branch 12 20 60.0
condition 1 3 33.3
subroutine 9 9 100.0
pod 0 3 0.0
total 65 78 83.3


line stmt bran cond sub pod time code
1             package ExtUtils::Helpers::Unix;
2             $ExtUtils::Helpers::Unix::VERSION = '0.028';
3 4     4   46 use strict;
  4         7  
  4         186  
4 4     4   20 use warnings FATAL => 'all';
  4         7  
  4         284  
5              
6 4     4   24 use Exporter 5.57 'import';
  4         65  
  4         244  
7             our @EXPORT = qw/make_executable split_like_shell detildefy/;
8              
9 4     4   23 use Carp qw/croak/;
  4         7  
  4         1644  
10 4     4   24 use Config;
  4         39  
  4         213  
11 4     4   2357 use Text::ParseWords 3.24 qw/shellwords/;
  4         7812  
  4         3221  
12              
13             my $layer = $] >= 5.008001 ? ":raw" : "";
14              
15             sub make_executable {
16 1     1 0 262292 my $filename = shift;
17 1         24 my $current_mode = (stat $filename)[2] + 0;
18 1 50       50 if (-T $filename) {
19 1         42 open my $fh, "<$layer", $filename;
20 1         18 my @lines = <$fh>;
21 1 50 33     142 if (@lines and $lines[0] =~ s{ \A \#! \s* (?:/\S+/)? perl \b (.*) \z }{$Config{startperl}$1}xms) {
22 1 50       168 open my $out, ">$layer", "$filename.new" or croak "Couldn't open $filename.new: $!";
23 1         40 print $out @lines;
24 1         63 close $out;
25 1 50       163 rename $filename, "$filename.bak" or croak "Couldn't rename $filename to $filename.bak";
26 1 50       113 rename "$filename.new", $filename or croak "Couldn't rename $filename.new to $filename";
27 1         142 unlink "$filename.bak";
28             }
29             }
30 1         33 chmod $current_mode | oct(111), $filename;
31 1         9 return;
32             }
33              
34             sub split_like_shell {
35 5     5 0 214534 my ($string) = @_;
36              
37 5 50       20 return if not defined $string;
38 5         54 $string =~ s/^\s+|\s+$//g;
39 5 50       19 return if not length $string;
40              
41 5         15 return shellwords($string);
42             }
43              
44             sub detildefy {
45 9     9 0 215294 my $value = shift;
46             # tilde with optional username
47 9         38 for ($value) {
48 9 50       109 s{ ^ ~ (?= /|$)} [ $ENV{HOME} || (getpwuid $>)[7] ]ex or # tilde without user name
  5 100       44  
49 3 100       633 s{ ^ ~ ([^/]+) (?= /|$) } { (getpwnam $1)[7] || "~$1" }ex; # tilde with user name
50             }
51 9         110 return $value;
52             }
53              
54             1;
55              
56             # ABSTRACT: Unix specific helper bits
57              
58             __END__