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__ |