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 |