| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Pcore::Util::File; |
|
2
|
|
|
|
|
|
|
|
|
3
|
5
|
|
|
5
|
|
40
|
use Pcore; |
|
|
5
|
|
|
|
|
12
|
|
|
|
5
|
|
|
|
|
42
|
|
|
4
|
5
|
|
|
5
|
|
42
|
use Pcore::Util::Scalar qw[is_glob is_plain_arrayref is_plain_hashref]; |
|
|
5
|
|
|
|
|
14
|
|
|
|
5
|
|
|
|
|
40
|
|
|
5
|
5
|
|
|
5
|
|
50
|
use Fcntl qw[:DEFAULT]; |
|
|
5
|
|
|
|
|
14
|
|
|
|
5
|
|
|
|
|
2579
|
|
|
6
|
5
|
|
|
5
|
|
45
|
use Cwd qw[]; ## no critic qw[Modules::ProhibitEvilModules] |
|
|
5
|
|
|
|
|
13
|
|
|
|
5
|
|
|
|
|
115
|
|
|
7
|
5
|
|
|
5
|
|
29
|
use Config; |
|
|
5
|
|
|
|
|
13
|
|
|
|
5
|
|
|
|
|
38610
|
|
|
8
|
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
sub cat_path { |
|
10
|
0
|
|
|
0
|
0
|
0
|
return P->path( join q[/], splice @_, 1 ); |
|
11
|
|
|
|
|
|
|
} |
|
12
|
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
# return cwd, symlinks are resolved |
|
14
|
|
|
|
|
|
|
sub cwd { |
|
15
|
5
|
|
|
5
|
0
|
249
|
return P->path( Cwd::realpath(q[.]), is_dir => 1 ); |
|
16
|
|
|
|
|
|
|
} |
|
17
|
|
|
|
|
|
|
|
|
18
|
0
|
|
|
0
|
0
|
0
|
sub chdir ($path) { ## no critic qw[Subroutines::ProhibitBuiltinHomonyms] |
|
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
19
|
0
|
0
|
|
|
|
0
|
if ( defined wantarray ) { |
|
|
|
0
|
|
|
|
|
|
|
20
|
0
|
|
|
|
|
0
|
my $cwd = cwd->to_string; |
|
21
|
|
|
|
|
|
|
|
|
22
|
0
|
0
|
|
|
|
0
|
return unless chdir $path; |
|
23
|
|
|
|
|
|
|
|
|
24
|
0
|
|
|
|
|
0
|
state $init = !!require Pcore::Util::File::ChdirGuard; |
|
25
|
|
|
|
|
|
|
|
|
26
|
0
|
|
|
|
|
0
|
return Pcore::Util::File::ChdirGuard->new( { dir => $cwd } )->scope_guard; |
|
27
|
|
|
|
|
|
|
} |
|
28
|
|
|
|
|
|
|
elsif ( chdir $path ) { |
|
29
|
0
|
|
|
|
|
0
|
return; |
|
30
|
|
|
|
|
|
|
} |
|
31
|
|
|
|
|
|
|
else { |
|
32
|
0
|
|
|
|
|
0
|
die qq[Can't chdir to "$path"]; |
|
33
|
|
|
|
|
|
|
} |
|
34
|
|
|
|
|
|
|
} |
|
35
|
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
# change umask and return old umask |
|
37
|
0
|
|
|
0
|
0
|
0
|
sub umask ($mode) { ## no critic qw[Subroutines::ProhibitBuiltinHomonyms] |
|
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
38
|
0
|
0
|
|
|
|
0
|
return '00' if $MSWIN; |
|
39
|
|
|
|
|
|
|
|
|
40
|
0
|
0
|
|
|
|
0
|
if ( defined wantarray ) { |
|
41
|
0
|
|
|
|
|
0
|
state $init = !!require Pcore::Util::File::UmaskGuard; |
|
42
|
|
|
|
|
|
|
|
|
43
|
0
|
|
|
|
|
0
|
return Pcore::Util::File::UmaskGuard->new( { old_umask => CORE::umask calc_umask($mode) } ); |
|
44
|
|
|
|
|
|
|
} |
|
45
|
|
|
|
|
|
|
else { |
|
46
|
0
|
|
|
|
|
0
|
return CORE::umask calc_umask($mode); |
|
47
|
|
|
|
|
|
|
} |
|
48
|
|
|
|
|
|
|
} |
|
49
|
|
|
|
|
|
|
|
|
50
|
0
|
|
|
0
|
0
|
0
|
sub calc_umask ( $mode, % ) { |
|
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
51
|
0
|
0
|
|
|
|
0
|
return unless defined $mode; |
|
52
|
|
|
|
|
|
|
|
|
53
|
0
|
|
|
|
|
0
|
my %args = ( |
|
54
|
|
|
|
|
|
|
oct => 0, |
|
55
|
|
|
|
|
|
|
splice @_, 1, |
|
56
|
|
|
|
|
|
|
); |
|
57
|
|
|
|
|
|
|
|
|
58
|
0
|
0
|
|
|
|
0
|
if ( $mode =~ /[^[:digit:]]/smi ) { |
|
59
|
0
|
|
|
|
|
0
|
state $mode_cache = {}; |
|
60
|
|
|
|
|
|
|
|
|
61
|
0
|
0
|
|
|
|
0
|
if ( !exists $mode_cache->{$mode} ) { |
|
62
|
0
|
|
|
|
|
0
|
my $mode_val = 0b111_111_111; # all perms are disabled by default |
|
63
|
|
|
|
|
|
|
|
|
64
|
0
|
|
|
|
|
0
|
my @mode = map {lc} split //sm, $mode; |
|
|
0
|
|
|
|
|
0
|
|
|
65
|
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
# user |
|
67
|
0
|
0
|
0
|
|
|
0
|
$mode_val &= 0b011_111_111 if defined $mode[0] && $mode[0] eq q[r]; |
|
68
|
0
|
0
|
0
|
|
|
0
|
$mode_val &= 0b101_111_111 if defined $mode[1] && $mode[1] eq q[w]; |
|
69
|
0
|
0
|
0
|
|
|
0
|
$mode_val &= 0b110_111_111 if defined $mode[2] && $mode[2] eq q[x]; |
|
70
|
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
# group |
|
72
|
0
|
0
|
0
|
|
|
0
|
$mode_val &= 0b111_011_111 if defined $mode[3] && $mode[3] eq q[r]; |
|
73
|
0
|
0
|
0
|
|
|
0
|
$mode_val &= 0b111_101_111 if defined $mode[4] && $mode[4] eq q[w]; |
|
74
|
0
|
0
|
0
|
|
|
0
|
$mode_val &= 0b111_110_111 if defined $mode[5] && $mode[5] eq q[x]; |
|
75
|
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
# other |
|
77
|
0
|
0
|
0
|
|
|
0
|
$mode_val &= 0b111_111_011 if defined $mode[6] && $mode[6] eq q[r]; |
|
78
|
0
|
0
|
0
|
|
|
0
|
$mode_val &= 0b111_111_101 if defined $mode[7] && $mode[7] eq q[w]; |
|
79
|
0
|
0
|
0
|
|
|
0
|
$mode_val &= 0b111_111_110 if defined $mode[8] && $mode[8] eq q[x]; |
|
80
|
|
|
|
|
|
|
|
|
81
|
0
|
|
|
|
|
0
|
$mode_cache->{$mode} = $mode_val; |
|
82
|
|
|
|
|
|
|
} |
|
83
|
|
|
|
|
|
|
|
|
84
|
0
|
|
|
|
|
0
|
$mode = $mode_cache->{$mode}; |
|
85
|
|
|
|
|
|
|
} |
|
86
|
|
|
|
|
|
|
else { |
|
87
|
0
|
0
|
|
|
|
0
|
$mode = oct $mode if substr( $mode, 0, 1 ) eq '0'; |
|
88
|
|
|
|
|
|
|
} |
|
89
|
|
|
|
|
|
|
|
|
90
|
0
|
0
|
|
|
|
0
|
return $args{oct} ? sprintf '0%o', $mode : $mode; |
|
91
|
|
|
|
|
|
|
} |
|
92
|
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
# mkdir with chmod support |
|
94
|
0
|
|
|
0
|
0
|
0
|
sub mkdir ( $path, $mode = undef ) { ## no critic qw[Subroutines::ProhibitBuiltinHomonyms] |
|
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
95
|
0
|
0
|
|
|
|
0
|
if ( defined wantarray ) { |
|
96
|
0
|
0
|
|
|
|
0
|
if ( defined $mode ) { |
|
97
|
0
|
|
|
|
|
0
|
return mkdir $path, calc_chmod($mode); |
|
98
|
|
|
|
|
|
|
} |
|
99
|
|
|
|
|
|
|
else { |
|
100
|
0
|
|
|
|
|
0
|
return mkdir $path; |
|
101
|
|
|
|
|
|
|
} |
|
102
|
|
|
|
|
|
|
} |
|
103
|
|
|
|
|
|
|
else { |
|
104
|
0
|
0
|
|
|
|
0
|
if ( defined $mode ) { |
|
105
|
0
|
0
|
|
|
|
0
|
mkdir $path, calc_chmod($mode) or die qq[Can't mkdir "$path". $!]; |
|
106
|
|
|
|
|
|
|
} |
|
107
|
|
|
|
|
|
|
else { |
|
108
|
0
|
0
|
|
|
|
0
|
mkdir $path or die qq[Can't mkdir "$path". $!]; |
|
109
|
|
|
|
|
|
|
} |
|
110
|
|
|
|
|
|
|
|
|
111
|
0
|
|
|
|
|
0
|
return; |
|
112
|
|
|
|
|
|
|
} |
|
113
|
|
|
|
|
|
|
} |
|
114
|
|
|
|
|
|
|
|
|
115
|
0
|
|
|
0
|
0
|
0
|
sub chmod ( $mode, @path ) { ## no critic qw[Subroutines::ProhibitBuiltinHomonyms] |
|
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
116
|
0
|
0
|
|
|
|
0
|
if ( defined wantarray ) { |
|
117
|
0
|
|
|
|
|
0
|
return CORE::chmod calc_chmod($mode), @path; |
|
118
|
|
|
|
|
|
|
} |
|
119
|
|
|
|
|
|
|
else { |
|
120
|
0
|
|
0
|
|
|
0
|
return CORE::chmod( calc_chmod($mode), @path ) || die qq[$! during chmod $mode, ] . join q[, ], @path; |
|
121
|
|
|
|
|
|
|
} |
|
122
|
|
|
|
|
|
|
} |
|
123
|
|
|
|
|
|
|
|
|
124
|
10
|
|
|
10
|
0
|
23
|
sub calc_chmod ( $mode, % ) { |
|
|
10
|
|
|
|
|
24
|
|
|
|
10
|
|
|
|
|
19
|
|
|
125
|
10
|
50
|
|
|
|
34
|
return unless defined $mode; |
|
126
|
|
|
|
|
|
|
|
|
127
|
10
|
|
|
|
|
46
|
my %args = ( |
|
128
|
|
|
|
|
|
|
oct => 0, |
|
129
|
|
|
|
|
|
|
splice @_, 1, |
|
130
|
|
|
|
|
|
|
); |
|
131
|
|
|
|
|
|
|
|
|
132
|
10
|
50
|
|
|
|
65
|
if ( $mode =~ /[^[:digit:]]/smi ) { |
|
133
|
10
|
|
|
|
|
29
|
state $mode_cache = {}; |
|
134
|
|
|
|
|
|
|
|
|
135
|
10
|
100
|
|
|
|
600
|
if ( !exists $mode_cache->{$mode} ) { |
|
136
|
5
|
|
|
|
|
17
|
my $mode_val = 0; # all perms are disabled by default |
|
137
|
|
|
|
|
|
|
|
|
138
|
5
|
|
|
|
|
322
|
my @mode = map {lc} split //sm, $mode; |
|
|
45
|
|
|
|
|
112
|
|
|
139
|
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
# user |
|
141
|
5
|
50
|
33
|
|
|
47
|
$mode_val |= 0b100_000_000 if defined $mode[0] && $mode[0] eq q[r]; |
|
142
|
5
|
50
|
33
|
|
|
31
|
$mode_val |= 0b010_000_000 if defined $mode[1] && $mode[1] eq q[w]; |
|
143
|
5
|
50
|
33
|
|
|
32
|
$mode_val |= 0b001_000_000 if defined $mode[2] && $mode[2] eq q[x]; |
|
144
|
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
# group |
|
146
|
5
|
50
|
33
|
|
|
30
|
$mode_val |= 0b000_100_000 if defined $mode[3] && $mode[3] eq q[r]; |
|
147
|
5
|
50
|
33
|
|
|
32
|
$mode_val |= 0b000_010_000 if defined $mode[4] && $mode[4] eq q[w]; |
|
148
|
5
|
50
|
33
|
|
|
27
|
$mode_val |= 0b000_001_000 if defined $mode[5] && $mode[5] eq q[x]; |
|
149
|
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
# other |
|
151
|
5
|
50
|
33
|
|
|
32
|
$mode_val |= 0b000_000_100 if defined $mode[6] && $mode[6] eq q[r]; |
|
152
|
5
|
50
|
33
|
|
|
28
|
$mode_val |= 0b000_000_010 if defined $mode[7] && $mode[7] eq q[w]; |
|
153
|
5
|
50
|
33
|
|
|
26
|
$mode_val |= 0b000_000_001 if defined $mode[8] && $mode[8] eq q[x]; |
|
154
|
|
|
|
|
|
|
|
|
155
|
5
|
|
|
|
|
24
|
$mode_cache->{$mode} = $mode_val; |
|
156
|
|
|
|
|
|
|
} |
|
157
|
|
|
|
|
|
|
|
|
158
|
10
|
|
|
|
|
30
|
$mode = $mode_cache->{$mode}; |
|
159
|
|
|
|
|
|
|
} |
|
160
|
|
|
|
|
|
|
else { |
|
161
|
0
|
0
|
|
|
|
0
|
$mode = oct $mode if substr( $mode, 0, 1 ) eq '0'; |
|
162
|
|
|
|
|
|
|
} |
|
163
|
|
|
|
|
|
|
|
|
164
|
10
|
50
|
|
|
|
476
|
return $args{oct} ? sprintf '0%o', $mode : $mode; |
|
165
|
|
|
|
|
|
|
} |
|
166
|
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
# READ / WRITE |
|
168
|
8
|
|
|
8
|
0
|
19
|
sub read_bin ( $path, % ) { |
|
|
8
|
|
|
|
|
22
|
|
|
|
8
|
|
|
|
|
20
|
|
|
169
|
8
|
|
|
|
|
48
|
my %args = ( |
|
170
|
|
|
|
|
|
|
cb => undef, |
|
171
|
|
|
|
|
|
|
buf_size => 1_048_576, |
|
172
|
|
|
|
|
|
|
splice @_, 1, |
|
173
|
|
|
|
|
|
|
); |
|
174
|
|
|
|
|
|
|
|
|
175
|
8
|
|
|
|
|
40
|
my $fh = get_fh( $path, O_RDONLY, crlf => 0 ); |
|
176
|
|
|
|
|
|
|
|
|
177
|
8
|
|
|
|
|
28
|
my $tail = q[]; |
|
178
|
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
READ: |
|
180
|
16
|
|
|
|
|
218
|
my $bytes = read $fh, my $buf, $args{buf_size}; |
|
181
|
|
|
|
|
|
|
|
|
182
|
16
|
50
|
|
|
|
57
|
die qq[Couldn't read file "$path": $!] if !defined $bytes; |
|
183
|
|
|
|
|
|
|
|
|
184
|
16
|
50
|
|
|
|
49
|
if ( $args{cb} ) { |
|
185
|
0
|
0
|
|
|
|
0
|
if ($bytes) { |
|
186
|
0
|
0
|
|
|
|
0
|
return if !$args{cb}->( \$buf ); |
|
187
|
|
|
|
|
|
|
|
|
188
|
0
|
|
|
|
|
0
|
goto READ; |
|
189
|
|
|
|
|
|
|
} |
|
190
|
|
|
|
|
|
|
else { |
|
191
|
0
|
|
|
|
|
0
|
$args{cb}->(undef); |
|
192
|
|
|
|
|
|
|
|
|
193
|
0
|
|
|
|
|
0
|
return; |
|
194
|
|
|
|
|
|
|
} |
|
195
|
|
|
|
|
|
|
} |
|
196
|
|
|
|
|
|
|
else { |
|
197
|
16
|
100
|
|
|
|
40
|
if ($bytes) { |
|
198
|
8
|
|
|
|
|
30
|
$tail .= $buf; |
|
199
|
|
|
|
|
|
|
|
|
200
|
8
|
|
|
|
|
73
|
goto READ; |
|
201
|
|
|
|
|
|
|
} |
|
202
|
|
|
|
|
|
|
else { |
|
203
|
8
|
|
|
|
|
110
|
return \$tail; |
|
204
|
|
|
|
|
|
|
} |
|
205
|
|
|
|
|
|
|
} |
|
206
|
|
|
|
|
|
|
} |
|
207
|
|
|
|
|
|
|
|
|
208
|
2
|
|
|
2
|
0
|
6
|
sub read_text ( $path, % ) { |
|
|
2
|
|
|
|
|
7
|
|
|
|
2
|
|
|
|
|
6
|
|
|
209
|
2
|
|
|
|
|
19
|
my %args = ( |
|
210
|
|
|
|
|
|
|
crlf => 1, # undef - auto, 1 - on, 0 - off (for binary files) |
|
211
|
|
|
|
|
|
|
binmode => ':encoding(UTF-8)', |
|
212
|
|
|
|
|
|
|
cb => undef, |
|
213
|
|
|
|
|
|
|
buf_size => 1_048_576, |
|
214
|
|
|
|
|
|
|
splice @_, 1, |
|
215
|
|
|
|
|
|
|
); |
|
216
|
|
|
|
|
|
|
|
|
217
|
2
|
|
|
|
|
13
|
my $fh = get_fh( $path, O_RDONLY, crlf => $args{crlf}, binmode => $args{binmode} ); |
|
218
|
|
|
|
|
|
|
|
|
219
|
2
|
|
|
|
|
6
|
my $tail = q[]; |
|
220
|
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
READ: |
|
222
|
4
|
|
|
|
|
1828
|
my $bytes = read $fh, my $buf, $args{buf_size}; |
|
223
|
|
|
|
|
|
|
|
|
224
|
4
|
50
|
|
|
|
5806
|
die qq[Couldn't read file "$path": $!] if !defined $bytes; |
|
225
|
|
|
|
|
|
|
|
|
226
|
4
|
50
|
|
|
|
20
|
if ( $args{cb} ) { |
|
227
|
0
|
0
|
|
|
|
0
|
if ($bytes) { |
|
228
|
0
|
0
|
|
|
|
0
|
return if !$args{cb}->( \$buf ); |
|
229
|
|
|
|
|
|
|
|
|
230
|
0
|
|
|
|
|
0
|
goto READ; |
|
231
|
|
|
|
|
|
|
} |
|
232
|
|
|
|
|
|
|
else { |
|
233
|
0
|
|
|
|
|
0
|
$args{cb}->(undef); |
|
234
|
|
|
|
|
|
|
|
|
235
|
0
|
|
|
|
|
0
|
return; |
|
236
|
|
|
|
|
|
|
} |
|
237
|
|
|
|
|
|
|
} |
|
238
|
|
|
|
|
|
|
else { |
|
239
|
4
|
100
|
|
|
|
13
|
if ($bytes) { |
|
240
|
2
|
|
|
|
|
285
|
$tail .= $buf; |
|
241
|
|
|
|
|
|
|
|
|
242
|
2
|
|
|
|
|
22
|
goto READ; |
|
243
|
|
|
|
|
|
|
} |
|
244
|
|
|
|
|
|
|
else { |
|
245
|
2
|
|
|
|
|
6173
|
return \$tail; |
|
246
|
|
|
|
|
|
|
} |
|
247
|
|
|
|
|
|
|
} |
|
248
|
|
|
|
|
|
|
} |
|
249
|
|
|
|
|
|
|
|
|
250
|
0
|
|
|
0
|
0
|
0
|
sub read_lines ( $path, % ) { |
|
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
251
|
0
|
|
|
|
|
0
|
my %args = ( |
|
252
|
|
|
|
|
|
|
crlf => 1, # undef - auto, 1 - on, 0 - off (for binary files) |
|
253
|
|
|
|
|
|
|
binmode => ':encoding(UTF-8)', |
|
254
|
|
|
|
|
|
|
cb => undef, |
|
255
|
|
|
|
|
|
|
buf_size => 1_048_576, |
|
256
|
|
|
|
|
|
|
empty_lines => 0, # only for array_ref mode, don't skip empty lines |
|
257
|
|
|
|
|
|
|
splice @_, 1, |
|
258
|
|
|
|
|
|
|
); |
|
259
|
|
|
|
|
|
|
|
|
260
|
0
|
|
|
|
|
0
|
my $fh = get_fh( $path, O_RDONLY, crlf => $args{crlf}, binmode => $args{binmode} ); |
|
261
|
|
|
|
|
|
|
|
|
262
|
0
|
|
|
|
|
0
|
my $tail = q[]; |
|
263
|
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
READ: |
|
265
|
0
|
|
|
|
|
0
|
my $bytes = read $fh, my $buf, $args{buf_size}; |
|
266
|
|
|
|
|
|
|
|
|
267
|
0
|
0
|
|
|
|
0
|
die qq[Couldn't read file "$path": $!] if !defined $bytes; |
|
268
|
|
|
|
|
|
|
|
|
269
|
0
|
0
|
|
|
|
0
|
if ( $args{cb} ) { |
|
270
|
0
|
0
|
|
|
|
0
|
if ($bytes) { |
|
271
|
0
|
0
|
|
|
|
0
|
if ( index( $buf, qq[\n] ) == -1 ) { # buf doesn't contains strings |
|
272
|
0
|
|
|
|
|
0
|
$tail .= $buf; |
|
273
|
|
|
|
|
|
|
} |
|
274
|
|
|
|
|
|
|
else { # buf contains strings |
|
275
|
0
|
|
|
|
|
0
|
$buf = $tail . $buf; |
|
276
|
|
|
|
|
|
|
|
|
277
|
0
|
0
|
|
|
|
0
|
if ( $args{empty_lines} ) { |
|
278
|
0
|
|
|
|
|
0
|
my $array_ref = [ split /\n/sm, $buf, -1 ]; |
|
279
|
|
|
|
|
|
|
|
|
280
|
0
|
|
|
|
|
0
|
$tail = pop $array_ref->@*; |
|
281
|
|
|
|
|
|
|
|
|
282
|
0
|
0
|
|
|
|
0
|
return if !$args{cb}->($array_ref); |
|
283
|
|
|
|
|
|
|
} |
|
284
|
|
|
|
|
|
|
else { |
|
285
|
0
|
|
|
|
|
0
|
my $array_ref = [ split /\n+/sm, $buf ]; |
|
286
|
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
# remove leading q[], preserved by split |
|
288
|
0
|
0
|
0
|
|
|
0
|
shift $array_ref->@* if defined $array_ref->[0] && $array_ref->[0] eq q[]; |
|
289
|
|
|
|
|
|
|
|
|
290
|
0
|
0
|
|
|
|
0
|
if ( substr( $buf, -1, 1 ) ne qq[\n] ) { |
|
291
|
0
|
|
|
|
|
0
|
$tail = pop $array_ref->@*; |
|
292
|
|
|
|
|
|
|
} |
|
293
|
|
|
|
|
|
|
else { |
|
294
|
0
|
|
|
|
|
0
|
$tail = q[]; |
|
295
|
|
|
|
|
|
|
} |
|
296
|
|
|
|
|
|
|
|
|
297
|
0
|
0
|
|
|
|
0
|
if ( $array_ref->@* ) { |
|
298
|
0
|
0
|
|
|
|
0
|
return if !$args{cb}->($array_ref); |
|
299
|
|
|
|
|
|
|
} |
|
300
|
|
|
|
|
|
|
} |
|
301
|
|
|
|
|
|
|
} |
|
302
|
|
|
|
|
|
|
|
|
303
|
0
|
|
|
|
|
0
|
goto READ; |
|
304
|
|
|
|
|
|
|
} |
|
305
|
|
|
|
|
|
|
else { |
|
306
|
0
|
0
|
|
|
|
0
|
if ( $tail ne q[] ) { |
|
307
|
0
|
0
|
|
|
|
0
|
return if !$args{cb}->( [$tail] ); |
|
308
|
|
|
|
|
|
|
} |
|
309
|
|
|
|
|
|
|
|
|
310
|
0
|
|
|
|
|
0
|
$args{cb}->(undef); |
|
311
|
|
|
|
|
|
|
|
|
312
|
0
|
|
|
|
|
0
|
return; |
|
313
|
|
|
|
|
|
|
} |
|
314
|
|
|
|
|
|
|
} |
|
315
|
|
|
|
|
|
|
else { |
|
316
|
0
|
0
|
|
|
|
0
|
if ($bytes) { |
|
317
|
0
|
|
|
|
|
0
|
$tail .= $buf; |
|
318
|
|
|
|
|
|
|
|
|
319
|
0
|
|
|
|
|
0
|
goto READ; |
|
320
|
|
|
|
|
|
|
} |
|
321
|
|
|
|
|
|
|
else { |
|
322
|
0
|
0
|
|
|
|
0
|
if ( $args{empty_lines} ) { |
|
323
|
0
|
|
|
|
|
0
|
my $array_ref = [ split /\n/sm, $tail, -1 ]; |
|
324
|
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
# remove trailing q[], preserved by split |
|
326
|
0
|
0
|
0
|
|
|
0
|
pop $array_ref->@* if defined $array_ref->[-1] && $array_ref->[-1] eq q[]; |
|
327
|
|
|
|
|
|
|
|
|
328
|
0
|
|
|
|
|
0
|
return $array_ref; |
|
329
|
|
|
|
|
|
|
} |
|
330
|
|
|
|
|
|
|
else { |
|
331
|
0
|
|
|
|
|
0
|
my $array_ref = [ split /\n+/sm, $tail ]; |
|
332
|
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
# remove leading q[], preserved by split |
|
334
|
0
|
0
|
0
|
|
|
0
|
shift $array_ref->@* if defined $array_ref->[0] && $array_ref->[0] eq q[]; |
|
335
|
|
|
|
|
|
|
|
|
336
|
0
|
|
|
|
|
0
|
return $array_ref; |
|
337
|
|
|
|
|
|
|
} |
|
338
|
|
|
|
|
|
|
} |
|
339
|
|
|
|
|
|
|
} |
|
340
|
|
|
|
|
|
|
} |
|
341
|
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
sub write_bin { |
|
343
|
0
|
|
|
0
|
0
|
0
|
my $path = shift; |
|
344
|
|
|
|
|
|
|
my %args = ( |
|
345
|
|
|
|
|
|
|
mode => 'rw-------', |
|
346
|
|
|
|
|
|
|
umask => undef, |
|
347
|
|
|
|
|
|
|
autoflush => 1, |
|
348
|
0
|
0
|
|
|
|
0
|
( is_plain_hashref $_[0] ? %{ shift @_ } : () ), |
|
|
0
|
|
|
|
|
0
|
|
|
349
|
|
|
|
|
|
|
); |
|
350
|
|
|
|
|
|
|
|
|
351
|
0
|
|
|
|
|
0
|
_write_to_fh( get_fh( $path, O_WRONLY | O_CREAT | O_TRUNC, %args, crlf => 0 ), @_ ); |
|
352
|
|
|
|
|
|
|
|
|
353
|
0
|
|
|
|
|
0
|
return; |
|
354
|
|
|
|
|
|
|
} |
|
355
|
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
sub append_bin { |
|
357
|
0
|
|
|
0
|
0
|
0
|
my $path = shift; |
|
358
|
|
|
|
|
|
|
my %args = ( |
|
359
|
|
|
|
|
|
|
mode => 'rw-------', |
|
360
|
|
|
|
|
|
|
umask => undef, |
|
361
|
|
|
|
|
|
|
autoflush => 1, |
|
362
|
0
|
0
|
|
|
|
0
|
( is_plain_hashref $_[0] ? %{ shift @_ } : () ), |
|
|
0
|
|
|
|
|
0
|
|
|
363
|
|
|
|
|
|
|
); |
|
364
|
|
|
|
|
|
|
|
|
365
|
0
|
|
|
|
|
0
|
_write_to_fh( get_fh( $path, O_WRONLY | O_CREAT | O_APPEND, %args, crlf => 0 ), @_ ); |
|
366
|
|
|
|
|
|
|
|
|
367
|
0
|
|
|
|
|
0
|
return; |
|
368
|
|
|
|
|
|
|
} |
|
369
|
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
sub write_text { |
|
371
|
0
|
|
|
0
|
0
|
0
|
my $path = shift; |
|
372
|
|
|
|
|
|
|
my %args = ( |
|
373
|
|
|
|
|
|
|
crlf => undef, # undef - auto, 1 - on, 0 - off (for binary files) |
|
374
|
|
|
|
|
|
|
binmode => ':encoding(UTF-8)', |
|
375
|
|
|
|
|
|
|
autoflush => 1, |
|
376
|
|
|
|
|
|
|
mode => 'rw-------', |
|
377
|
|
|
|
|
|
|
umask => undef, |
|
378
|
0
|
0
|
|
|
|
0
|
( is_plain_hashref $_[0] ? %{ shift @_ } : () ), |
|
|
0
|
|
|
|
|
0
|
|
|
379
|
|
|
|
|
|
|
); |
|
380
|
|
|
|
|
|
|
|
|
381
|
0
|
|
|
|
|
0
|
_write_to_fh( get_fh( $path, O_WRONLY | O_CREAT | O_TRUNC, %args ), @_ ); |
|
382
|
|
|
|
|
|
|
|
|
383
|
0
|
|
|
|
|
0
|
return; |
|
384
|
|
|
|
|
|
|
} |
|
385
|
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
sub append_text { |
|
387
|
0
|
|
|
0
|
0
|
0
|
my $path = shift; |
|
388
|
|
|
|
|
|
|
my %args = ( |
|
389
|
|
|
|
|
|
|
crlf => undef, # undef - auto, 1 - on, 0 - off (for binary files) |
|
390
|
|
|
|
|
|
|
binmode => ':encoding(UTF-8)', |
|
391
|
|
|
|
|
|
|
autoflush => 1, |
|
392
|
|
|
|
|
|
|
mode => 'rw-------', |
|
393
|
|
|
|
|
|
|
umask => undef, |
|
394
|
0
|
0
|
|
|
|
0
|
( is_plain_hashref $_[0] ? %{ shift @_ } : () ), |
|
|
0
|
|
|
|
|
0
|
|
|
395
|
|
|
|
|
|
|
); |
|
396
|
|
|
|
|
|
|
|
|
397
|
0
|
|
|
|
|
0
|
_write_to_fh( get_fh( $path, O_WRONLY | O_CREAT | O_APPEND, %args ), @_ ); |
|
398
|
|
|
|
|
|
|
|
|
399
|
0
|
|
|
|
|
0
|
return; |
|
400
|
|
|
|
|
|
|
} |
|
401
|
|
|
|
|
|
|
|
|
402
|
10
|
|
|
10
|
0
|
22
|
sub encode_path ($path) { |
|
|
10
|
|
|
|
|
23
|
|
|
|
10
|
|
|
|
|
20
|
|
|
403
|
10
|
50
|
|
|
|
35
|
if ($MSWIN) { |
|
404
|
0
|
|
|
|
|
0
|
state $enc = Encode::find_encoding($Pcore::WIN_ENC); |
|
405
|
|
|
|
|
|
|
|
|
406
|
0
|
0
|
|
|
|
0
|
return $enc->encode( $path, Encode::FB_CROAK ) if utf8::is_utf8($path); |
|
407
|
|
|
|
|
|
|
} |
|
408
|
|
|
|
|
|
|
|
|
409
|
10
|
|
|
|
|
28
|
return $path; |
|
410
|
|
|
|
|
|
|
} |
|
411
|
|
|
|
|
|
|
|
|
412
|
10
|
|
|
10
|
0
|
24
|
sub get_fh ( $path, $mode, @ ) { |
|
|
10
|
|
|
|
|
24
|
|
|
|
10
|
|
|
|
|
19
|
|
|
|
10
|
|
|
|
|
20
|
|
|
413
|
10
|
|
|
|
|
83
|
my %args = ( |
|
414
|
|
|
|
|
|
|
mode => 'rw-------', |
|
415
|
|
|
|
|
|
|
umask => undef, |
|
416
|
|
|
|
|
|
|
crlf => 0, # undef - auto, 1 - on, 0 - off (for binary files) |
|
417
|
|
|
|
|
|
|
binmode => undef, |
|
418
|
|
|
|
|
|
|
autoflush => 1, |
|
419
|
|
|
|
|
|
|
splice @_, 2, |
|
420
|
|
|
|
|
|
|
); |
|
421
|
|
|
|
|
|
|
|
|
422
|
10
|
50
|
|
|
|
57
|
if ( is_glob $path ) { |
|
423
|
0
|
|
|
|
|
0
|
return $path; |
|
424
|
|
|
|
|
|
|
} |
|
425
|
|
|
|
|
|
|
else { |
|
426
|
10
|
|
|
|
|
25
|
my $umask_guard; |
|
427
|
|
|
|
|
|
|
|
|
428
|
10
|
50
|
|
|
|
42
|
$umask_guard = &umask( $args{umask} ) if defined $args{umask}; ## no critic qw[Subroutines::ProhibitAmpersandSigils] |
|
429
|
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
# encode filename to native OS encoding |
|
431
|
10
|
|
|
|
|
41
|
$path = encode_path($path); |
|
432
|
|
|
|
|
|
|
|
|
433
|
10
|
50
|
|
|
|
87
|
sysopen my $fh, $path, $mode, calc_chmod( $args{mode} ) or die qq[Can't open file "$path"]; |
|
434
|
|
|
|
|
|
|
|
|
435
|
10
|
|
|
|
|
44
|
my $binmode = q[]; |
|
436
|
|
|
|
|
|
|
|
|
437
|
10
|
0
|
33
|
|
|
48
|
$args{crlf} //= $MSWIN ? 1 : 0; |
|
438
|
|
|
|
|
|
|
|
|
439
|
10
|
100
|
|
|
|
38
|
if ( $args{crlf} ) { |
|
440
|
2
|
50
|
|
|
|
11
|
$binmode = ':crlf' if !$MSWIN; |
|
441
|
|
|
|
|
|
|
} |
|
442
|
|
|
|
|
|
|
else { |
|
443
|
8
|
50
|
|
|
|
27
|
$binmode = ':raw' if $MSWIN; |
|
444
|
|
|
|
|
|
|
} |
|
445
|
|
|
|
|
|
|
|
|
446
|
10
|
100
|
|
|
|
42
|
$binmode .= $args{binmode} if $args{binmode}; |
|
447
|
|
|
|
|
|
|
|
|
448
|
10
|
100
|
50
|
|
|
66
|
binmode $fh, $binmode or die qq[Can't set binmode file "$path"] if $binmode; |
|
449
|
|
|
|
|
|
|
|
|
450
|
10
|
50
|
|
|
|
609
|
$fh->autoflush(1) if $args{autoflush}; |
|
451
|
|
|
|
|
|
|
|
|
452
|
10
|
|
|
|
|
37020
|
return $fh; |
|
453
|
|
|
|
|
|
|
} |
|
454
|
|
|
|
|
|
|
} |
|
455
|
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
sub _write_to_fh { |
|
457
|
0
|
|
|
0
|
|
0
|
my $fh = shift; |
|
458
|
|
|
|
|
|
|
|
|
459
|
0
|
|
|
|
|
0
|
for my $str (@_) { |
|
460
|
0
|
0
|
|
|
|
0
|
if ( is_plain_arrayref $str ) { |
|
|
|
0
|
|
|
|
|
|
|
461
|
0
|
|
|
|
|
0
|
for my $line ( $str->@* ) { |
|
462
|
0
|
|
|
|
|
0
|
print {$fh} $line, qq[\n]; |
|
|
0
|
|
|
|
|
0
|
|
|
463
|
|
|
|
|
|
|
} |
|
464
|
|
|
|
|
|
|
} |
|
465
|
|
|
|
|
|
|
elsif ( ref $str eq 'SCALAR' ) { |
|
466
|
0
|
|
|
|
|
0
|
print {$fh} $str->$*; |
|
|
0
|
|
|
|
|
0
|
|
|
467
|
|
|
|
|
|
|
} |
|
468
|
|
|
|
|
|
|
else { |
|
469
|
0
|
|
|
|
|
0
|
print {$fh} $str; |
|
|
0
|
|
|
|
|
0
|
|
|
470
|
|
|
|
|
|
|
} |
|
471
|
|
|
|
|
|
|
} |
|
472
|
|
|
|
|
|
|
|
|
473
|
0
|
|
|
|
|
0
|
return; |
|
474
|
|
|
|
|
|
|
} |
|
475
|
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
# READ DIR |
|
477
|
0
|
|
|
0
|
0
|
0
|
sub read_dir ( $path, % ) { |
|
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
478
|
0
|
|
|
|
|
0
|
my %args = ( |
|
479
|
|
|
|
|
|
|
keep_dot => 0, |
|
480
|
|
|
|
|
|
|
full_path => 0, |
|
481
|
|
|
|
|
|
|
splice @_, 1, |
|
482
|
|
|
|
|
|
|
); |
|
483
|
|
|
|
|
|
|
|
|
484
|
0
|
0
|
|
|
|
0
|
opendir my $dh, $path or die qq[Can't open dir "$path"]; |
|
485
|
|
|
|
|
|
|
|
|
486
|
0
|
|
|
|
|
0
|
my $files; |
|
487
|
|
|
|
|
|
|
|
|
488
|
0
|
0
|
|
|
|
0
|
if ( $args{keep_dot} ) { |
|
489
|
0
|
|
|
|
|
0
|
$files = [ readdir $dh ]; |
|
490
|
|
|
|
|
|
|
} |
|
491
|
|
|
|
|
|
|
else { |
|
492
|
0
|
0
|
|
|
|
0
|
$files = [ grep { $_ ne q[.] && $_ ne q[..] } readdir $dh ]; |
|
|
0
|
|
|
|
|
0
|
|
|
493
|
|
|
|
|
|
|
} |
|
494
|
|
|
|
|
|
|
|
|
495
|
0
|
0
|
|
|
|
0
|
if ( $args{full_path} ) { |
|
496
|
0
|
|
|
|
|
0
|
my $path = P->path( $path, is_dir => 1 ); |
|
497
|
|
|
|
|
|
|
|
|
498
|
0
|
|
|
|
|
0
|
$files = [ map { $path . $_ } $files->@* ]; |
|
|
0
|
|
|
|
|
0
|
|
|
499
|
|
|
|
|
|
|
} |
|
500
|
|
|
|
|
|
|
|
|
501
|
0
|
0
|
|
|
|
0
|
closedir $dh or die; |
|
502
|
|
|
|
|
|
|
|
|
503
|
0
|
|
|
|
|
0
|
return $files; |
|
504
|
|
|
|
|
|
|
} |
|
505
|
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
# TOUCH |
|
507
|
0
|
|
|
0
|
0
|
0
|
sub touch ( $path, % ) { |
|
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
508
|
0
|
|
|
|
|
0
|
my %args = ( |
|
509
|
|
|
|
|
|
|
atime => undef, |
|
510
|
|
|
|
|
|
|
mtime => undef, |
|
511
|
|
|
|
|
|
|
mode => q[rw-------], |
|
512
|
|
|
|
|
|
|
umask => undef, |
|
513
|
|
|
|
|
|
|
splice @_, 1, |
|
514
|
|
|
|
|
|
|
); |
|
515
|
|
|
|
|
|
|
|
|
516
|
0
|
|
|
|
|
0
|
$path = encode_path($path); |
|
517
|
|
|
|
|
|
|
|
|
518
|
0
|
0
|
|
|
|
0
|
if ( !-e $path ) { |
|
519
|
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
# set umask if defined |
|
521
|
0
|
0
|
|
|
|
0
|
my $umask_guard = defined $args{umask} ? &umask( $args{umask} ) : undef; ## no critic qw[Subroutines::ProhibitAmpersandSigils] |
|
522
|
|
|
|
|
|
|
|
|
523
|
0
|
0
|
|
|
|
0
|
sysopen my $FH, $path, Fcntl::O_WRONLY | Fcntl::O_CREAT | Fcntl::O_APPEND, calc_chmod( $args{mode} ) or die qq[Can't touch file "$path"]; |
|
524
|
|
|
|
|
|
|
|
|
525
|
0
|
0
|
|
|
|
0
|
close $FH or die; |
|
526
|
|
|
|
|
|
|
} |
|
527
|
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
# set utime |
|
529
|
0
|
|
0
|
|
|
0
|
$args{atime} //= $args{mtime} // time; |
|
|
|
|
0
|
|
|
|
|
|
530
|
0
|
|
0
|
|
|
0
|
$args{mtime} //= $args{atime}; |
|
531
|
0
|
0
|
|
|
|
0
|
utime $args{atime}, $args{mtime}, $path or die; |
|
532
|
|
|
|
|
|
|
|
|
533
|
0
|
|
|
|
|
0
|
return; |
|
534
|
|
|
|
|
|
|
} |
|
535
|
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
# MKPATH, RMTREE, EMPTY_DIR |
|
537
|
0
|
|
|
0
|
0
|
0
|
sub mkpath ( $path, % ) { |
|
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
538
|
0
|
|
|
|
|
0
|
my %args = ( |
|
539
|
|
|
|
|
|
|
mode => q[rwx------], |
|
540
|
|
|
|
|
|
|
umask => undef, |
|
541
|
|
|
|
|
|
|
splice @_, 1, |
|
542
|
|
|
|
|
|
|
); |
|
543
|
|
|
|
|
|
|
|
|
544
|
0
|
|
|
|
|
0
|
state $init = !!require File::Path; |
|
545
|
|
|
|
|
|
|
|
|
546
|
0
|
|
|
|
|
0
|
$args{mode} = calc_chmod( $args{mode} ); |
|
547
|
|
|
|
|
|
|
|
|
548
|
0
|
0
|
|
|
|
0
|
my $umask_guard = defined $args{umask} ? &umask( delete $args{umask} ) : delete $args{umask}; ## no critic qw[Subroutines::ProhibitAmpersandSigils] |
|
549
|
|
|
|
|
|
|
|
|
550
|
0
|
|
|
|
|
0
|
return File::Path::make_path( "$path", \%args ); |
|
551
|
|
|
|
|
|
|
} |
|
552
|
|
|
|
|
|
|
|
|
553
|
0
|
|
|
0
|
0
|
0
|
sub rmtree ( $path, @ ) { |
|
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
554
|
0
|
|
|
|
|
0
|
my %args = ( |
|
555
|
|
|
|
|
|
|
safe => 0, # 0 - will attempts to alter file permission |
|
556
|
|
|
|
|
|
|
keep_root => 0, |
|
557
|
|
|
|
|
|
|
splice @_, 1, |
|
558
|
|
|
|
|
|
|
); |
|
559
|
|
|
|
|
|
|
|
|
560
|
0
|
|
|
|
|
0
|
state $init = !!require File::Path; |
|
561
|
|
|
|
|
|
|
|
|
562
|
0
|
|
|
|
|
0
|
my $error; |
|
563
|
|
|
|
|
|
|
|
|
564
|
0
|
|
|
|
|
0
|
$args{error} = \$error; |
|
565
|
|
|
|
|
|
|
|
|
566
|
0
|
|
|
|
|
0
|
my $removed = File::Path::remove_tree( "$path", \%args ); |
|
567
|
|
|
|
|
|
|
|
|
568
|
0
|
0
|
|
|
|
0
|
return $error->@* ? () : 1; |
|
569
|
|
|
|
|
|
|
} |
|
570
|
|
|
|
|
|
|
|
|
571
|
0
|
|
|
0
|
0
|
0
|
sub empty_dir ( $path, @ ) { |
|
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
572
|
0
|
|
|
|
|
0
|
my %args = ( |
|
573
|
|
|
|
|
|
|
safe => 0, # 0 - will attempts to alter file permission |
|
574
|
|
|
|
|
|
|
splice @_, 1, |
|
575
|
|
|
|
|
|
|
keep_root => 1, |
|
576
|
|
|
|
|
|
|
); |
|
577
|
|
|
|
|
|
|
|
|
578
|
0
|
|
|
|
|
0
|
state $init = !!require File::Path; |
|
579
|
|
|
|
|
|
|
|
|
580
|
0
|
|
|
|
|
0
|
return File::Path::remove_tree( "$path", \%args ); |
|
581
|
|
|
|
|
|
|
} |
|
582
|
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
# TEMP |
|
584
|
0
|
|
|
0
|
0
|
0
|
sub tempfile (%args) { |
|
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
585
|
0
|
|
|
|
|
0
|
state $init = !!require Pcore::Util::File::TempFile; |
|
586
|
|
|
|
|
|
|
|
|
587
|
0
|
|
|
|
|
0
|
return Pcore::Util::File::TempFile->new(%args); |
|
588
|
|
|
|
|
|
|
} |
|
589
|
|
|
|
|
|
|
|
|
590
|
5
|
|
|
5
|
0
|
13
|
sub tempdir (%args) { |
|
|
5
|
|
|
|
|
25
|
|
|
|
5
|
|
|
|
|
15
|
|
|
591
|
5
|
|
|
|
|
2106
|
state $init = !!require Pcore::Util::File::TempDir; |
|
592
|
|
|
|
|
|
|
|
|
593
|
5
|
|
|
|
|
38
|
return Pcore::Util::File::TempDir->new( \%args ); |
|
594
|
|
|
|
|
|
|
} |
|
595
|
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
sub temppath { |
|
597
|
|
|
|
|
|
|
my %args = ( |
|
598
|
|
|
|
|
|
|
base => $ENV->{TEMP_DIR}, |
|
599
|
0
|
|
|
0
|
0
|
|
suffix => q[], |
|
600
|
|
|
|
|
|
|
tmpl => 'temp-' . $$ . '-XXXXXXXX', |
|
601
|
|
|
|
|
|
|
@_, |
|
602
|
|
|
|
|
|
|
); |
|
603
|
|
|
|
|
|
|
|
|
604
|
0
|
0
|
0
|
|
|
|
$args{suffix} = q[.] . $args{suffix} if defined $args{suffix} && $args{suffix} ne q[] && substr( $args{suffix}, 0, 1 ) ne q[.]; |
|
|
|
|
0
|
|
|
|
|
|
605
|
|
|
|
|
|
|
|
|
606
|
0
|
|
|
|
|
|
state $init = !!require Pcore::Util::File::TempFile; |
|
607
|
|
|
|
|
|
|
|
|
608
|
0
|
0
|
|
|
|
|
mkpath( $args{base} ) if !-e $args{base}; |
|
609
|
|
|
|
|
|
|
|
|
610
|
0
|
|
|
|
|
|
my $attempt = 3; |
|
611
|
|
|
|
|
|
|
|
|
612
|
0
|
0
|
|
|
|
|
REDO: |
|
613
|
|
|
|
|
|
|
die q[Can't create temporary path] if !$attempt--; |
|
614
|
|
|
|
|
|
|
|
|
615
|
0
|
|
|
|
|
|
my $filename = $args{tmpl} =~ s/X/$Pcore::Util::File::TempFile::TMPL->[rand $Pcore::Util::File::TempFile::TMPL->@*]/smger . $args{suffix}; |
|
|
0
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
|
|
617
|
0
|
0
|
|
|
|
|
goto REDO if -e $args{base} . q[/] . $filename; |
|
618
|
|
|
|
|
|
|
|
|
619
|
0
|
|
|
|
|
|
return P->path( $args{base} . q[/] . $filename ); |
|
620
|
|
|
|
|
|
|
} |
|
621
|
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
# COPY / MOVE FILE |
|
623
|
0
|
|
|
0
|
0
|
|
sub copy ( $from, $to, @ ) { |
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
624
|
0
|
|
|
|
|
|
my %args = ( |
|
625
|
|
|
|
|
|
|
glob => undef, |
|
626
|
|
|
|
|
|
|
dir_mode => q[rwxr-xr-x], |
|
627
|
|
|
|
|
|
|
umask => undef, |
|
628
|
|
|
|
|
|
|
buf_size => undef, |
|
629
|
|
|
|
|
|
|
copy_link => 0, # if 1 - symlinks will be copied as symlinks |
|
630
|
|
|
|
|
|
|
rm_file => 1, # remove target file before copying, 0 - off, 1 - die if can't remove, 2 - return if can't remove |
|
631
|
|
|
|
|
|
|
rm_dir => 1, # remove target dir before copying, 0 - off, 1 - die if can't remove, 2 - return if can't remove |
|
632
|
|
|
|
|
|
|
pfs_check => 1, |
|
633
|
|
|
|
|
|
|
cprf => 1, # only if $to is dir, if $to/ is exists put $from/ content into $to/ instead of replace $to/ with $from/ |
|
634
|
|
|
|
|
|
|
splice @_, 2, |
|
635
|
|
|
|
|
|
|
); |
|
636
|
|
|
|
|
|
|
|
|
637
|
0
|
0
|
|
|
|
|
my $umask_guard = defined $args{umask} ? &umask( $args{umask} ) : undef; ## no critic qw[Subroutines::ProhibitAmpersandSigils] |
|
638
|
|
|
|
|
|
|
|
|
639
|
0
|
|
|
|
|
|
local $File::Copy::Recursive::DirPerms = calc_chmod( $args{dir_mode}, oct => 1 ); |
|
640
|
0
|
|
|
|
|
|
local $File::Copy::Recursive::CopyLink = $args{copy_link}; |
|
641
|
0
|
|
|
|
|
|
local $File::Copy::Recursive::RMTrgFil = $args{rm_file}; |
|
642
|
0
|
|
|
|
|
|
local $File::Copy::Recursive::RMTrgDir = $args{rm_dir}; |
|
643
|
0
|
|
|
|
|
|
local $File::Copy::Recursive::PFSCheck = $args{pfs_check}; |
|
644
|
0
|
|
|
|
|
|
local $File::Copy::Recursive::CPRFComp = $args{cprf}; |
|
645
|
|
|
|
|
|
|
|
|
646
|
0
|
|
|
|
|
|
state $init = !!require File::Copy::Recursive; |
|
647
|
|
|
|
|
|
|
|
|
648
|
0
|
0
|
|
|
|
|
if ( -d $from ) { |
|
|
|
0
|
|
|
|
|
|
|
649
|
0
|
0
|
|
|
|
|
if ( $args{glob} ) { |
|
650
|
0
|
|
0
|
|
|
|
return File::Copy::Recursive::rcopy_glob( qq[$from/$args{glob}], $to, $args{buf_size} // () ); |
|
651
|
|
|
|
|
|
|
} |
|
652
|
|
|
|
|
|
|
else { |
|
653
|
0
|
|
0
|
|
|
|
return File::Copy::Recursive::dircopy( $from, $to, $args{buf_size} // () ); |
|
654
|
|
|
|
|
|
|
} |
|
655
|
|
|
|
|
|
|
} |
|
656
|
|
|
|
|
|
|
elsif ( -f $from ) { |
|
657
|
0
|
|
0
|
|
|
|
return File::Copy::Recursive::fcopy( $from, $to, $args{buf_size} // () ); |
|
658
|
|
|
|
|
|
|
} |
|
659
|
|
|
|
|
|
|
else { |
|
660
|
0
|
|
|
|
|
|
die qq[Source "$from" not exists]; |
|
661
|
|
|
|
|
|
|
} |
|
662
|
|
|
|
|
|
|
|
|
663
|
0
|
|
|
|
|
|
return; |
|
664
|
|
|
|
|
|
|
} |
|
665
|
|
|
|
|
|
|
|
|
666
|
0
|
|
|
0
|
0
|
|
sub move ( $from, $to, @ ) { |
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
667
|
0
|
|
|
|
|
|
my %args = ( |
|
668
|
|
|
|
|
|
|
dir_mode => q[rwxr-xr-x], |
|
669
|
|
|
|
|
|
|
umask => undef, |
|
670
|
|
|
|
|
|
|
buf_size => undef, |
|
671
|
|
|
|
|
|
|
copy_link => 0, # if 1 - symlinks will be copied as symlinks |
|
672
|
|
|
|
|
|
|
rm_file => 1, # remove target file before copying, 0 - off, 1 - die if can't remove, 2 - return if can't remove |
|
673
|
|
|
|
|
|
|
rm_dir => 1, # remove target dir before copying, 0 - off, 1 - die if can't remove, 2 - return if can't remove |
|
674
|
|
|
|
|
|
|
pfs_check => 1, |
|
675
|
|
|
|
|
|
|
cprf => 1, # only if $to is dir, if $to/ is exists put $from/ content into $to/ instead of replace $to/ with $from/ |
|
676
|
|
|
|
|
|
|
splice @_, 2, |
|
677
|
|
|
|
|
|
|
); |
|
678
|
|
|
|
|
|
|
|
|
679
|
0
|
0
|
|
|
|
|
my $umask_guard = defined $args{umask} ? &umask( $args{umask} ) : undef; ## no critic qw[Subroutines::ProhibitAmpersandSigils] |
|
680
|
|
|
|
|
|
|
|
|
681
|
0
|
|
|
|
|
|
local $File::Copy::Recursive::DirPerms = calc_chmod( $args{dir_mode}, oct => 1 ); |
|
682
|
0
|
|
|
|
|
|
local $File::Copy::Recursive::CopyLink = $args{copy_link}; |
|
683
|
0
|
|
|
|
|
|
local $File::Copy::Recursive::RMTrgFil = $args{rm_file}; |
|
684
|
0
|
|
|
|
|
|
local $File::Copy::Recursive::RMTrgDir = $args{rm_dir}; |
|
685
|
0
|
|
|
|
|
|
local $File::Copy::Recursive::PFSCheck = $args{pfs_check}; |
|
686
|
0
|
|
|
|
|
|
local $File::Copy::Recursive::CPRFComp = $args{cprf}; |
|
687
|
|
|
|
|
|
|
|
|
688
|
0
|
|
|
|
|
|
state $init = !!require File::Copy::Recursive; |
|
689
|
|
|
|
|
|
|
|
|
690
|
0
|
0
|
|
|
|
|
if ( -d $from ) { |
|
|
|
0
|
|
|
|
|
|
|
691
|
0
|
0
|
|
|
|
|
if ( $args{glob} ) { |
|
692
|
0
|
|
0
|
|
|
|
return File::Copy::Recursive::rmove_glob( qq[$from/$args{glob}], $to, $args{buf_size} // () ); |
|
693
|
|
|
|
|
|
|
} |
|
694
|
|
|
|
|
|
|
else { |
|
695
|
0
|
|
0
|
|
|
|
return File::Copy::Recursive::dirmove( $from, $to, $args{buf_size} // () ); |
|
696
|
|
|
|
|
|
|
} |
|
697
|
|
|
|
|
|
|
} |
|
698
|
|
|
|
|
|
|
elsif ( -f $from ) { |
|
699
|
0
|
|
0
|
|
|
|
return File::Copy::Recursive::fmove( $from, $to, $args{buf_size} // () ); |
|
700
|
|
|
|
|
|
|
} |
|
701
|
|
|
|
|
|
|
else { |
|
702
|
0
|
|
|
|
|
|
die qq[Source "$from" not exists]; |
|
703
|
|
|
|
|
|
|
} |
|
704
|
|
|
|
|
|
|
|
|
705
|
0
|
|
|
|
|
|
return; |
|
706
|
|
|
|
|
|
|
} |
|
707
|
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
# FIND |
|
709
|
0
|
|
|
0
|
0
|
|
sub find ( $path, @ ) { |
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
710
|
0
|
|
|
|
|
|
my %args = ( |
|
711
|
|
|
|
|
|
|
abs => 0, # return absolute path |
|
712
|
|
|
|
|
|
|
dir => 1, # return found dirs |
|
713
|
|
|
|
|
|
|
file => 1, # return found files |
|
714
|
|
|
|
|
|
|
splice @_, 1, -1, |
|
715
|
|
|
|
|
|
|
); |
|
716
|
|
|
|
|
|
|
|
|
717
|
0
|
0
|
|
|
|
|
$path = P->path( $path, is_dir => 1 )->realpath or return; |
|
718
|
|
|
|
|
|
|
|
|
719
|
0
|
|
|
|
|
|
my $cb = $_[-1]; |
|
720
|
|
|
|
|
|
|
|
|
721
|
0
|
|
|
|
|
|
my $chdir_guard; |
|
722
|
|
|
|
|
|
|
|
|
723
|
0
|
0
|
|
|
|
|
$chdir_guard = &chdir($path) if !$args{abs}; ## no critic qw[Subroutines::ProhibitAmpersandSigils] |
|
724
|
|
|
|
|
|
|
|
|
725
|
0
|
|
|
|
|
|
my $read_dir; |
|
726
|
|
|
|
|
|
|
|
|
727
|
0
|
|
|
0
|
|
|
$read_dir = sub ($dirpath) { |
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
728
|
0
|
|
|
|
|
|
for my $file ( read_dir($dirpath)->@* ) { |
|
729
|
0
|
|
|
|
|
|
$file = $dirpath . q[/] . Encode::decode( $Pcore::WIN_ENC, $file, Encode::FB_CROAK ); |
|
730
|
|
|
|
|
|
|
|
|
731
|
0
|
0
|
|
|
|
|
if ( -d $file ) { |
|
732
|
0
|
|
|
|
|
|
$file = P->path( $file, is_dir => 1 ); |
|
733
|
|
|
|
|
|
|
|
|
734
|
0
|
0
|
|
|
|
|
$cb->($file) if $args{dir}; |
|
735
|
|
|
|
|
|
|
|
|
736
|
0
|
|
|
|
|
|
$read_dir->($file); |
|
737
|
|
|
|
|
|
|
} |
|
738
|
|
|
|
|
|
|
else { |
|
739
|
0
|
|
|
|
|
|
$file = P->path( $file, is_dir => 0 ); |
|
740
|
|
|
|
|
|
|
|
|
741
|
0
|
0
|
|
|
|
|
$cb->($file) if $args{file}; |
|
742
|
|
|
|
|
|
|
} |
|
743
|
|
|
|
|
|
|
} |
|
744
|
|
|
|
|
|
|
|
|
745
|
0
|
|
|
|
|
|
return; |
|
746
|
0
|
|
|
|
|
|
}; |
|
747
|
|
|
|
|
|
|
|
|
748
|
0
|
0
|
|
|
|
|
$read_dir->( $args{abs} ? $path : q[./] ); |
|
749
|
|
|
|
|
|
|
|
|
750
|
0
|
|
|
|
|
|
return; |
|
751
|
|
|
|
|
|
|
} |
|
752
|
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
# WHERE |
|
754
|
0
|
|
|
0
|
0
|
|
sub where ( $filename ) { |
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
755
|
0
|
|
|
|
|
|
my $wantarray = wantarray; |
|
756
|
|
|
|
|
|
|
|
|
757
|
0
|
|
|
|
|
|
state $env_path = q[]; |
|
758
|
|
|
|
|
|
|
|
|
759
|
0
|
|
|
|
|
|
state $paths; |
|
760
|
|
|
|
|
|
|
|
|
761
|
0
|
0
|
|
|
|
|
if ( $env_path ne $ENV{PATH} ) { |
|
762
|
0
|
|
|
|
|
|
$env_path = $ENV{PATH}; |
|
763
|
|
|
|
|
|
|
|
|
764
|
0
|
|
|
|
|
|
$paths = [ q[.], grep {$_} split /$Config{path_sep}/sm, $ENV{PATH} ]; |
|
|
0
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
} |
|
766
|
|
|
|
|
|
|
|
|
767
|
0
|
|
|
|
|
|
state $env_pathext = q[]; |
|
768
|
|
|
|
|
|
|
|
|
769
|
0
|
|
|
|
|
|
state $pathext = [q[]]; |
|
770
|
|
|
|
|
|
|
|
|
771
|
0
|
0
|
0
|
|
|
|
if ( $MSWIN && $ENV{PATHEXT} && $env_pathext ne $ENV{PATHEXT} ) { |
|
|
|
|
0
|
|
|
|
|
|
772
|
0
|
|
|
|
|
|
$env_pathext = $ENV{PATHEXT}; |
|
773
|
|
|
|
|
|
|
|
|
774
|
0
|
|
|
|
|
|
$pathext = [ q[], grep {$_} split /$Config{path_sep}/sm, $ENV{PATHEXT} ]; |
|
|
0
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
} |
|
776
|
|
|
|
|
|
|
|
|
777
|
0
|
|
|
|
|
|
my @res; |
|
778
|
|
|
|
|
|
|
|
|
779
|
0
|
|
|
|
|
|
for my $path ( $paths->@* ) { |
|
780
|
0
|
|
|
|
|
|
for my $ext ( $pathext->@* ) { |
|
781
|
0
|
0
|
|
|
|
|
if ( -e "$path/${filename}${ext}" ) { |
|
782
|
0
|
0
|
|
|
|
|
if ($wantarray) { |
|
783
|
0
|
|
|
|
|
|
push @res, P->path("$path/${filename}${ext}")->realpath; |
|
784
|
|
|
|
|
|
|
} |
|
785
|
|
|
|
|
|
|
else { |
|
786
|
0
|
|
|
|
|
|
return P->path("$path/${filename}${ext}")->realpath; |
|
787
|
|
|
|
|
|
|
} |
|
788
|
|
|
|
|
|
|
} |
|
789
|
|
|
|
|
|
|
} |
|
790
|
|
|
|
|
|
|
} |
|
791
|
|
|
|
|
|
|
|
|
792
|
0
|
|
|
|
|
|
return @res; |
|
793
|
|
|
|
|
|
|
} |
|
794
|
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
# UNTAR |
|
796
|
0
|
|
|
0
|
0
|
|
sub untar ( $tar, $target, @ ) { |
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
797
|
0
|
|
|
|
|
|
state $init = !!require Archive::Tar; |
|
798
|
|
|
|
|
|
|
|
|
799
|
0
|
|
|
|
|
|
my %args = ( |
|
800
|
|
|
|
|
|
|
strip_component => 0, |
|
801
|
|
|
|
|
|
|
splice @_, 2, |
|
802
|
|
|
|
|
|
|
); |
|
803
|
|
|
|
|
|
|
|
|
804
|
0
|
|
|
|
|
|
$tar = Archive::Tar->new($tar); |
|
805
|
|
|
|
|
|
|
|
|
806
|
0
|
|
|
|
|
|
my $strip_component; |
|
807
|
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
my @extracted; |
|
809
|
|
|
|
|
|
|
|
|
810
|
0
|
|
|
|
|
|
for my $file ( $tar->get_files ) { |
|
811
|
0
|
0
|
|
|
|
|
next if !$file->is_file; |
|
812
|
|
|
|
|
|
|
|
|
813
|
0
|
|
|
|
|
|
my $path = P->path( q[/] . $file->full_path )->to_string; |
|
814
|
|
|
|
|
|
|
|
|
815
|
0
|
0
|
|
|
|
|
if ( $args{strip_component} ) { |
|
816
|
0
|
0
|
|
|
|
|
if ( !$strip_component ) { |
|
817
|
0
|
|
|
|
|
|
my @labels = split m[/]sm, $path; |
|
818
|
|
|
|
|
|
|
|
|
819
|
0
|
0
|
|
|
|
|
die q[Can't strip component, path is too short] if @labels < $args{strip_component}; |
|
820
|
|
|
|
|
|
|
|
|
821
|
0
|
|
|
|
|
|
$strip_component = P->path( q[/] . join( q[/], splice @labels, 0, $args{strip_component} + 1 ) )->to_string; |
|
822
|
|
|
|
|
|
|
} |
|
823
|
|
|
|
|
|
|
|
|
824
|
0
|
0
|
|
|
|
|
die qq[Can't strip component "$strip_component" from path "$path"] if $path !~ s[\A$strip_component][]sm; |
|
825
|
|
|
|
|
|
|
} |
|
826
|
|
|
|
|
|
|
|
|
827
|
0
|
|
|
|
|
|
my $target_path = P->path("$target/$path"); |
|
828
|
|
|
|
|
|
|
|
|
829
|
0
|
0
|
|
|
|
|
P->file->mkpath( $target_path->dirname ) if !-e $target_path->dirname; |
|
830
|
|
|
|
|
|
|
|
|
831
|
0
|
0
|
|
|
|
|
if ( $file->extract($target_path) ) { |
|
832
|
0
|
|
|
|
|
|
push @extracted, $target_path; |
|
833
|
|
|
|
|
|
|
} |
|
834
|
|
|
|
|
|
|
else { |
|
835
|
0
|
|
|
|
|
|
die qq[Can't extract "$path"]; |
|
836
|
|
|
|
|
|
|
} |
|
837
|
|
|
|
|
|
|
} |
|
838
|
|
|
|
|
|
|
|
|
839
|
0
|
|
|
|
|
|
return \@extracted; |
|
840
|
|
|
|
|
|
|
} |
|
841
|
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
1; |
|
843
|
|
|
|
|
|
|
## -----SOURCE FILTER LOG BEGIN----- |
|
844
|
|
|
|
|
|
|
## |
|
845
|
|
|
|
|
|
|
## PerlCritic profile "pcore-script" policy violations: |
|
846
|
|
|
|
|
|
|
## +------+----------------------+----------------------------------------------------------------------------------------------------------------+ |
|
847
|
|
|
|
|
|
|
## | Sev. | Lines | Policy | |
|
848
|
|
|
|
|
|
|
## |======+======================+================================================================================================================| |
|
849
|
|
|
|
|
|
|
## | 3 | | Subroutines::ProhibitExcessComplexity | |
|
850
|
|
|
|
|
|
|
## | | 50 | * Subroutine "calc_umask" with high complexity score (25) | |
|
851
|
|
|
|
|
|
|
## | | 124 | * Subroutine "calc_chmod" with high complexity score (25) | |
|
852
|
|
|
|
|
|
|
## | | 250 | * Subroutine "read_lines" with high complexity score (27) | |
|
853
|
|
|
|
|
|
|
## |------+----------------------+----------------------------------------------------------------------------------------------------------------| |
|
854
|
|
|
|
|
|
|
## | 1 | 821 | CodeLayout::ProhibitParensWithBuiltins - Builtin function called with parentheses | |
|
855
|
|
|
|
|
|
|
## +------+----------------------+----------------------------------------------------------------------------------------------------------------+ |
|
856
|
|
|
|
|
|
|
## |
|
857
|
|
|
|
|
|
|
## -----SOURCE FILTER LOG END----- |
|
858
|
|
|
|
|
|
|
__END__ |
|
859
|
|
|
|
|
|
|
=pod |
|
860
|
|
|
|
|
|
|
|
|
861
|
|
|
|
|
|
|
=encoding utf8 |
|
862
|
|
|
|
|
|
|
|
|
863
|
|
|
|
|
|
|
=head1 NAME |
|
864
|
|
|
|
|
|
|
|
|
865
|
|
|
|
|
|
|
Pcore::Util::File |
|
866
|
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
868
|
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
870
|
|
|
|
|
|
|
|
|
871
|
|
|
|
|
|
|
=cut |