line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#line 1 |
2
|
|
|
|
|
|
|
package File::Copy::Recursive; |
3
|
1
|
|
|
1
|
|
2863
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
50
|
|
4
|
|
|
|
|
|
|
use strict; |
5
|
|
|
|
|
|
|
BEGIN { |
6
|
1
|
50
|
|
1
|
|
17
|
# Keep older versions of Perl from trying to use lexical warnings |
7
|
|
|
|
|
|
|
$INC{'warnings.pm'} = "fake warnings entry for < 5.6 perl ($])" if $] < 5.006; |
8
|
1
|
|
|
1
|
|
5
|
} |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
31
|
|
9
|
|
|
|
|
|
|
use warnings; |
10
|
1
|
|
|
1
|
|
5
|
|
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
60
|
|
11
|
1
|
|
|
1
|
|
908
|
use Carp; |
|
1
|
|
|
|
|
4825
|
|
|
1
|
|
|
|
|
67
|
|
12
|
1
|
|
|
1
|
|
7
|
use File::Copy; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
38
|
|
13
|
|
|
|
|
|
|
use File::Spec; #not really needed because File::Copy already gets it, but for good measure :) |
14
|
1
|
|
|
|
|
2912
|
|
15
|
|
|
|
|
|
|
use vars qw( |
16
|
|
|
|
|
|
|
@ISA @EXPORT_OK $VERSION $MaxDepth $KeepMode $CPRFComp $CopyLink |
17
|
|
|
|
|
|
|
$PFSCheck $RemvBase $NoFtlPth $ForcePth $CopyLoop $RMTrgFil $RMTrgDir |
18
|
1
|
|
|
1
|
|
5
|
$CondCopy $BdTrgWrn $SkipFlop $DirPerms |
|
1
|
|
|
|
|
3
|
|
19
|
|
|
|
|
|
|
); |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
require Exporter; |
22
|
|
|
|
|
|
|
@ISA = qw(Exporter); |
23
|
|
|
|
|
|
|
@EXPORT_OK = qw(fcopy rcopy dircopy fmove rmove dirmove pathmk pathrm pathempty pathrmdir); |
24
|
|
|
|
|
|
|
$VERSION = '0.38'; |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
$MaxDepth = 0; |
27
|
|
|
|
|
|
|
$KeepMode = 1; |
28
|
|
|
|
|
|
|
$CPRFComp = 0; |
29
|
|
|
|
|
|
|
$CopyLink = eval { local $SIG{'__DIE__'};symlink '',''; 1 } || 0; |
30
|
|
|
|
|
|
|
$PFSCheck = 1; |
31
|
|
|
|
|
|
|
$RemvBase = 0; |
32
|
|
|
|
|
|
|
$NoFtlPth = 0; |
33
|
|
|
|
|
|
|
$ForcePth = 0; |
34
|
|
|
|
|
|
|
$CopyLoop = 0; |
35
|
|
|
|
|
|
|
$RMTrgFil = 0; |
36
|
|
|
|
|
|
|
$RMTrgDir = 0; |
37
|
|
|
|
|
|
|
$CondCopy = {}; |
38
|
|
|
|
|
|
|
$BdTrgWrn = 0; |
39
|
|
|
|
|
|
|
$SkipFlop = 0; |
40
|
|
|
|
|
|
|
$DirPerms = 0777; |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
my $samecheck = sub { |
43
|
|
|
|
|
|
|
return 1 if $^O eq 'MSWin32'; # need better way to check for this on winders... |
44
|
|
|
|
|
|
|
return if @_ != 2 || !defined $_[0] || !defined $_[1]; |
45
|
|
|
|
|
|
|
return if $_[0] eq $_[1]; |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
my $one = ''; |
48
|
|
|
|
|
|
|
if($PFSCheck) { |
49
|
|
|
|
|
|
|
$one = join( '-', ( stat $_[0] )[0,1] ) || ''; |
50
|
|
|
|
|
|
|
my $two = join( '-', ( stat $_[1] )[0,1] ) || ''; |
51
|
|
|
|
|
|
|
if ( $one eq $two && $one ) { |
52
|
|
|
|
|
|
|
carp "$_[0] and $_[1] are identical"; |
53
|
|
|
|
|
|
|
return; |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
if(-d $_[0] && !$CopyLoop) { |
58
|
|
|
|
|
|
|
$one = join( '-', ( stat $_[0] )[0,1] ) if !$one; |
59
|
|
|
|
|
|
|
my $abs = File::Spec->rel2abs($_[1]); |
60
|
|
|
|
|
|
|
my @pth = File::Spec->splitdir( $abs ); |
61
|
|
|
|
|
|
|
while(@pth) { |
62
|
|
|
|
|
|
|
my $cur = File::Spec->catdir(@pth); |
63
|
|
|
|
|
|
|
last if !$cur; # probably not necessary, but nice to have just in case :) |
64
|
|
|
|
|
|
|
my $two = join( '-', ( stat $cur )[0,1] ) || ''; |
65
|
|
|
|
|
|
|
if ( $one eq $two && $one ) { |
66
|
|
|
|
|
|
|
# $! = 62; # Too many levels of symbolic links |
67
|
|
|
|
|
|
|
carp "Caught Deep Recursion Condition: $_[0] contains $_[1]"; |
68
|
|
|
|
|
|
|
return; |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
pop @pth; |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
return 1; |
76
|
|
|
|
|
|
|
}; |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
my $glob = sub { |
79
|
|
|
|
|
|
|
my ($do, $src_glob, @args) = @_; |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
local $CPRFComp = 1; |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
my @rt; |
84
|
|
|
|
|
|
|
for my $path ( glob($src_glob) ) { |
85
|
|
|
|
|
|
|
my @call = [$do->($path, @args)] or return; |
86
|
|
|
|
|
|
|
push @rt, \@call; |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
return @rt; |
90
|
|
|
|
|
|
|
}; |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
my $move = sub { |
93
|
|
|
|
|
|
|
my $fl = shift; |
94
|
|
|
|
|
|
|
my @x; |
95
|
|
|
|
|
|
|
if($fl) { |
96
|
|
|
|
|
|
|
@x = fcopy(@_) or return; |
97
|
|
|
|
|
|
|
} else { |
98
|
|
|
|
|
|
|
@x = dircopy(@_) or return; |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
if(@x) { |
101
|
|
|
|
|
|
|
if($fl) { |
102
|
|
|
|
|
|
|
unlink $_[0] or return; |
103
|
|
|
|
|
|
|
} else { |
104
|
|
|
|
|
|
|
pathrmdir($_[0]) or return; |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
if($RemvBase) { |
107
|
|
|
|
|
|
|
my ($volm, $path) = File::Spec->splitpath($_[0]); |
108
|
|
|
|
|
|
|
pathrm(File::Spec->catpath($volm,$path,''), $ForcePth, $NoFtlPth) or return; |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
return wantarray ? @x : $x[0]; |
112
|
|
|
|
|
|
|
}; |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
my $ok_todo_asper_condcopy = sub { |
115
|
|
|
|
|
|
|
my $org = shift; |
116
|
|
|
|
|
|
|
my $copy = 1; |
117
|
|
|
|
|
|
|
if(exists $CondCopy->{$org}) { |
118
|
|
|
|
|
|
|
if($CondCopy->{$org}{'md5'}) { |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
if($copy) { |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
return $copy; |
126
|
|
|
|
|
|
|
}; |
127
|
|
|
|
|
|
|
|
128
|
28
|
50
|
|
28
|
1
|
52
|
sub fcopy { |
129
|
28
|
0
|
0
|
|
|
66
|
$samecheck->(@_) or return; |
|
|
|
33
|
|
|
|
|
130
|
0
|
|
|
|
|
0
|
if($RMTrgFil && (-d $_[1] || -e $_[1]) ) { |
131
|
0
|
0
|
|
|
|
0
|
my $trg = $_[1]; |
132
|
0
|
|
|
|
|
0
|
if( -d $trg ) { |
133
|
0
|
|
|
|
|
0
|
my @trgx = File::Spec->splitpath( $_[0] ); |
134
|
|
|
|
|
|
|
$trg = File::Spec->catfile( $_[1], $trgx[ $#trgx ] ); |
135
|
0
|
0
|
|
|
|
0
|
} |
136
|
0
|
0
|
|
|
|
0
|
$samecheck->($_[0], $trg) or return; |
137
|
0
|
0
|
|
|
|
0
|
if(-e $trg) { |
138
|
0
|
0
|
|
|
|
0
|
if($RMTrgFil == 1) { |
139
|
|
|
|
|
|
|
unlink $trg or carp "\$RMTrgFil failed: $!"; |
140
|
0
|
0
|
|
|
|
0
|
} else { |
141
|
|
|
|
|
|
|
unlink $trg or return; |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
} |
144
|
28
|
|
|
|
|
344
|
} |
145
|
28
|
50
|
33
|
|
|
495
|
my ($volm, $path) = File::Spec->splitpath($_[1]); |
146
|
0
|
|
|
|
|
0
|
if($path && !-d $path) { |
147
|
|
|
|
|
|
|
pathmk(File::Spec->catpath($volm,$path,''), $NoFtlPth); |
148
|
28
|
50
|
33
|
|
|
459
|
} |
149
|
0
|
0
|
0
|
|
|
0
|
if( -l $_[0] && $CopyLink ) { |
150
|
|
|
|
|
|
|
carp "Copying a symlink ($_[0]) whose target does not exist" |
151
|
0
|
0
|
|
|
|
0
|
if !-e readlink($_[0]) && $BdTrgWrn; |
152
|
|
|
|
|
|
|
symlink readlink(shift()), shift() or return; |
153
|
28
|
50
|
|
|
|
94
|
} else { |
154
|
|
|
|
|
|
|
copy(@_) or return; |
155
|
28
|
|
|
|
|
8818
|
|
156
|
28
|
50
|
|
|
|
532
|
my @base_file = File::Spec->splitpath($_[0]); |
157
|
|
|
|
|
|
|
my $mode_trg = -d $_[1] ? File::Spec->catfile($_[1], $base_file[ $#base_file ]) : $_[1]; |
158
|
28
|
50
|
|
|
|
1135
|
|
159
|
|
|
|
|
|
|
chmod scalar((stat($_[0]))[2]), $mode_trg if $KeepMode; |
160
|
28
|
50
|
|
|
|
115
|
} |
161
|
|
|
|
|
|
|
return wantarray ? (1,0,0) : 1; # use 0's incase they do math on them and in case rcopy() is called in list context = no uninit val warnings |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
1
|
0
|
33
|
1
|
1
|
318
|
sub rcopy { |
165
|
0
|
|
|
|
|
0
|
if (-l $_[0] && $CopyLink) { |
166
|
|
|
|
|
|
|
goto &fcopy; |
167
|
|
|
|
|
|
|
} |
168
|
1
|
50
|
33
|
|
|
20
|
|
169
|
0
|
|
|
|
|
0
|
goto &dircopy if -d $_[0] || substr( $_[0], ( 1 * -1), 1) eq '*'; |
170
|
|
|
|
|
|
|
goto &fcopy; |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
|
173
|
0
|
|
|
0
|
1
|
0
|
sub rcopy_glob { |
174
|
|
|
|
|
|
|
$glob->(\&rcopy, @_); |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
|
177
|
1
|
50
|
33
|
1
|
1
|
6
|
sub dircopy { |
178
|
0
|
0
|
|
|
|
0
|
if($RMTrgDir && -d $_[1]) { |
179
|
0
|
0
|
|
|
|
0
|
if($RMTrgDir == 1) { |
180
|
|
|
|
|
|
|
pathrmdir($_[1]) or carp "\$RMTrgDir failed: $!"; |
181
|
0
|
0
|
|
|
|
0
|
} else { |
182
|
|
|
|
|
|
|
pathrmdir($_[1]) or return; |
183
|
|
|
|
|
|
|
} |
184
|
1
|
|
|
|
|
2
|
} |
185
|
1
|
|
|
|
|
3
|
my $globstar = 0; |
186
|
1
|
|
|
|
|
3
|
my $_zero = $_[0]; |
187
|
1
|
50
|
|
|
|
4
|
my $_one = $_[1]; |
188
|
0
|
|
|
|
|
0
|
if ( substr( $_zero, ( 1 * -1 ), 1 ) eq '*') { |
189
|
0
|
|
|
|
|
0
|
$globstar = 1; |
190
|
|
|
|
|
|
|
$_zero = substr( $_zero, 0, ( length( $_zero ) - 1 ) ); |
191
|
|
|
|
|
|
|
} |
192
|
1
|
50
|
|
|
|
5
|
|
193
|
1
|
50
|
33
|
|
|
25
|
$samecheck->( $_zero, $_[1] ) or return; |
|
|
|
33
|
|
|
|
|
194
|
0
|
|
|
|
|
0
|
if ( !-d $_zero || ( -e $_[1] && !-d $_[1] ) ) { |
195
|
0
|
|
|
|
|
0
|
$! = 20; |
196
|
|
|
|
|
|
|
return; |
197
|
|
|
|
|
|
|
} |
198
|
1
|
50
|
|
|
|
10
|
|
199
|
1
|
50
|
|
|
|
5
|
if(!-d $_[1]) { |
200
|
|
|
|
|
|
|
pathmk($_[1], $NoFtlPth) or return; |
201
|
0
|
0
|
0
|
|
|
0
|
} else { |
202
|
0
|
|
|
|
|
0
|
if($CPRFComp && !$globstar) { |
203
|
0
|
|
|
|
|
0
|
my @parts = File::Spec->splitdir($_zero); |
|
0
|
|
|
|
|
0
|
|
204
|
0
|
|
|
|
|
0
|
while($parts[ $#parts ] eq '') { pop @parts; } |
205
|
|
|
|
|
|
|
$_one = File::Spec->catdir($_[1], $parts[$#parts]); |
206
|
|
|
|
|
|
|
} |
207
|
1
|
|
|
|
|
3
|
} |
208
|
1
|
|
|
|
|
2
|
my $baseend = $_one; |
209
|
1
|
|
|
|
|
1
|
my $level = 0; |
210
|
1
|
|
|
|
|
2
|
my $filen = 0; |
211
|
|
|
|
|
|
|
my $dirn = 0; |
212
|
1
|
|
|
|
|
2
|
|
213
|
|
|
|
|
|
|
my $recurs; #must be my()ed before sub {} since it calls itself |
214
|
17
|
|
|
17
|
|
32
|
$recurs = sub { |
215
|
17
|
100
|
|
|
|
39
|
my ($str,$end,$buf) = @_; |
216
|
17
|
100
|
|
|
|
33
|
$filen++ if $end eq $baseend; |
217
|
|
|
|
|
|
|
$dirn++ if $end eq $baseend; |
218
|
17
|
50
|
|
|
|
106
|
|
219
|
17
|
100
|
50
|
|
|
1674
|
$DirPerms = oct($DirPerms) if substr($DirPerms,0,1) eq '0'; |
220
|
17
|
50
|
|
|
|
1495
|
mkdir($end,$DirPerms) or return if !-d $end; |
221
|
17
|
0
|
33
|
|
|
62
|
chmod scalar((stat($str))[2]), $end if $KeepMode; |
|
|
|
33
|
|
|
|
|
222
|
0
|
0
|
|
|
|
0
|
if($MaxDepth && $MaxDepth =~ m/^\d+$/ && $level >= $MaxDepth) { |
223
|
0
|
|
|
|
|
0
|
return ($filen,$dirn,$level) if wantarray; |
224
|
|
|
|
|
|
|
return $filen; |
225
|
17
|
|
|
|
|
19
|
} |
226
|
|
|
|
|
|
|
$level++; |
227
|
|
|
|
|
|
|
|
228
|
17
|
|
|
|
|
21
|
|
229
|
17
|
50
|
|
|
|
47
|
my @files; |
230
|
0
|
0
|
|
|
|
0
|
if ( $] < 5.006 ) { |
231
|
0
|
|
0
|
|
|
0
|
opendir(STR_DH, $str) or return; |
232
|
0
|
|
|
|
|
0
|
@files = grep( $_ ne '.' && $_ ne '..', readdir(STR_DH)); |
233
|
|
|
|
|
|
|
closedir STR_DH; |
234
|
|
|
|
|
|
|
} |
235
|
17
|
50
|
|
|
|
493
|
else { |
236
|
17
|
|
100
|
|
|
644
|
opendir(my $str_dh, $str) or return; |
237
|
17
|
|
|
|
|
242
|
@files = grep( $_ ne '.' && $_ ne '..', readdir($str_dh)); |
238
|
|
|
|
|
|
|
closedir $str_dh; |
239
|
|
|
|
|
|
|
} |
240
|
17
|
|
|
|
|
32
|
|
241
|
44
|
|
|
|
|
193
|
for my $file (@files) { |
242
|
44
|
|
|
|
|
492
|
my ($file_ut) = $file =~ m{ (.*) }xms; |
243
|
44
|
|
|
|
|
358
|
my $org = File::Spec->catfile($str, $file_ut); |
244
|
44
|
50
|
33
|
|
|
1504
|
my $new = File::Spec->catfile($end, $file_ut); |
|
|
100
|
|
|
|
|
|
245
|
0
|
0
|
0
|
|
|
0
|
if( -l $org && $CopyLink ) { |
246
|
|
|
|
|
|
|
carp "Copying a symlink ($org) whose target does not exist" |
247
|
0
|
0
|
|
|
|
0
|
if !-e readlink($org) && $BdTrgWrn; |
248
|
|
|
|
|
|
|
symlink readlink($org), $new or return; |
249
|
|
|
|
|
|
|
} |
250
|
16
|
50
|
|
|
|
42
|
elsif(-d $org) { |
251
|
16
|
50
|
|
|
|
62
|
$recurs->($org,$new,$buf) if defined $buf; |
252
|
16
|
|
|
|
|
19
|
$recurs->($org,$new) if !defined $buf; |
253
|
16
|
|
|
|
|
31
|
$filen++; |
254
|
|
|
|
|
|
|
$dirn++; |
255
|
|
|
|
|
|
|
} |
256
|
28
|
50
|
|
|
|
69
|
else { |
257
|
28
|
50
|
|
|
|
45
|
if($ok_todo_asper_condcopy->($org)) { |
258
|
0
|
0
|
0
|
|
|
0
|
if($SkipFlop) { |
259
|
0
|
0
|
0
|
|
|
0
|
fcopy($org,$new,$buf) or next if defined $buf; |
260
|
|
|
|
|
|
|
fcopy($org,$new) or next if !defined $buf; |
261
|
|
|
|
|
|
|
} |
262
|
28
|
50
|
0
|
|
|
49
|
else { |
263
|
28
|
50
|
50
|
|
|
93
|
fcopy($org,$new,$buf) or return if defined $buf; |
264
|
|
|
|
|
|
|
fcopy($org,$new) or return if !defined $buf; |
265
|
28
|
50
|
|
|
|
1078
|
} |
266
|
28
|
|
|
|
|
99
|
chmod scalar((stat($org))[2]), $new if $KeepMode; |
267
|
|
|
|
|
|
|
$filen++; |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
} |
270
|
17
|
|
|
|
|
47
|
} |
271
|
1
|
|
|
|
|
12
|
1; |
272
|
|
|
|
|
|
|
}; |
273
|
1
|
50
|
|
|
|
7
|
|
274
|
1
|
50
|
|
|
|
10
|
$recurs->($_zero, $_one, $_[2]) or return; |
275
|
|
|
|
|
|
|
return wantarray ? ($filen,$dirn,$level) : $filen; |
276
|
|
|
|
|
|
|
} |
277
|
0
|
|
|
0
|
1
|
0
|
|
278
|
|
|
|
|
|
|
sub fmove { $move->(1, @_) } |
279
|
|
|
|
|
|
|
|
280
|
0
|
0
|
0
|
0
|
1
|
0
|
sub rmove { |
281
|
0
|
|
|
|
|
0
|
if (-l $_[0] && $CopyLink) { |
282
|
|
|
|
|
|
|
goto &fmove; |
283
|
|
|
|
|
|
|
} |
284
|
0
|
0
|
0
|
|
|
0
|
|
285
|
0
|
|
|
|
|
0
|
goto &dirmove if -d $_[0] || substr( $_[0], ( 1 * -1), 1) eq '*'; |
286
|
|
|
|
|
|
|
goto &fmove; |
287
|
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
|
|
289
|
0
|
|
|
0
|
1
|
0
|
sub rmove_glob { |
290
|
|
|
|
|
|
|
$glob->(\&rmove, @_); |
291
|
|
|
|
|
|
|
} |
292
|
0
|
|
|
0
|
1
|
0
|
|
293
|
|
|
|
|
|
|
sub dirmove { $move->(0, @_) } |
294
|
|
|
|
|
|
|
|
295
|
1
|
|
|
1
|
1
|
6
|
sub pathmk { |
296
|
1
|
|
|
|
|
2
|
my @parts = File::Spec->splitdir( shift() ); |
297
|
1
|
|
|
|
|
3
|
my $nofatal = shift; |
298
|
1
|
|
|
|
|
2
|
my $pth = $parts[0]; |
299
|
1
|
50
|
|
|
|
4
|
my $zer = 0; |
300
|
0
|
|
|
|
|
0
|
if(!$pth) { |
301
|
0
|
|
|
|
|
0
|
$pth = File::Spec->catdir($parts[0],$parts[1]); |
302
|
|
|
|
|
|
|
$zer = 1; |
303
|
1
|
|
|
|
|
4
|
} |
304
|
3
|
50
|
|
|
|
11
|
for($zer..$#parts) { |
305
|
3
|
50
|
50
|
|
|
176
|
$DirPerms = oct($DirPerms) if substr($DirPerms,0,1) eq '0'; |
|
|
|
66
|
|
|
|
|
306
|
3
|
50
|
33
|
|
|
41
|
mkdir($pth,$DirPerms) or return if !-d $pth && !$nofatal; |
307
|
3
|
100
|
|
|
|
31
|
mkdir($pth,$DirPerms) if !-d $pth && $nofatal; |
308
|
|
|
|
|
|
|
$pth = File::Spec->catdir($pth, $parts[$_ + 1]) unless $_ == $#parts; |
309
|
1
|
|
|
|
|
6
|
} |
310
|
|
|
|
|
|
|
1; |
311
|
|
|
|
|
|
|
} |
312
|
|
|
|
|
|
|
|
313
|
0
|
|
|
0
|
1
|
|
sub pathempty { |
314
|
|
|
|
|
|
|
my $pth = shift; |
315
|
0
|
0
|
|
|
|
|
|
316
|
|
|
|
|
|
|
return 2 if !-d $pth; |
317
|
0
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
my @names; |
319
|
0
|
0
|
|
|
|
|
my $pth_dh; |
320
|
0
|
0
|
|
|
|
|
if ( $] < 5.006 ) { |
321
|
0
|
|
|
|
|
|
opendir(PTH_DH, $pth) or return; |
322
|
|
|
|
|
|
|
@names = grep !/^\.+$/, readdir(PTH_DH); |
323
|
|
|
|
|
|
|
} |
324
|
0
|
0
|
|
|
|
|
else { |
325
|
0
|
|
|
|
|
|
opendir($pth_dh, $pth) or return; |
326
|
|
|
|
|
|
|
@names = grep !/^\.+$/, readdir($pth_dh); |
327
|
|
|
|
|
|
|
} |
328
|
0
|
|
|
|
|
|
|
329
|
0
|
|
|
|
|
|
for my $name (@names) { |
330
|
0
|
|
|
|
|
|
my ($name_ut) = $name =~ m{ (.*) }xms; |
331
|
|
|
|
|
|
|
my $flpth = File::Spec->catdir($pth, $name_ut); |
332
|
0
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
333
|
0
|
0
|
|
|
|
|
if( -l $flpth ) { |
334
|
|
|
|
|
|
|
unlink $flpth or return; |
335
|
|
|
|
|
|
|
} |
336
|
0
|
0
|
|
|
|
|
elsif(-d $flpth) { |
337
|
|
|
|
|
|
|
pathrmdir($flpth) or return; |
338
|
|
|
|
|
|
|
} |
339
|
0
|
0
|
|
|
|
|
else { |
340
|
|
|
|
|
|
|
unlink $flpth or return; |
341
|
|
|
|
|
|
|
} |
342
|
|
|
|
|
|
|
} |
343
|
0
|
0
|
|
|
|
|
|
344
|
0
|
|
|
|
|
|
if ( $] < 5.006 ) { |
345
|
|
|
|
|
|
|
closedir PTH_DH; |
346
|
|
|
|
|
|
|
} |
347
|
0
|
|
|
|
|
|
else { |
348
|
|
|
|
|
|
|
closedir $pth_dh; |
349
|
|
|
|
|
|
|
} |
350
|
0
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
1; |
352
|
|
|
|
|
|
|
} |
353
|
|
|
|
|
|
|
|
354
|
0
|
|
|
0
|
1
|
|
sub pathrm { |
355
|
0
|
0
|
|
|
|
|
my $path = shift; |
356
|
0
|
|
|
|
|
|
return 2 if !-d $path; |
357
|
0
|
|
|
|
|
|
my @pth = File::Spec->splitdir( $path ); |
358
|
|
|
|
|
|
|
my $force = shift; |
359
|
0
|
|
|
|
|
|
|
360
|
0
|
|
|
|
|
|
while(@pth) { |
361
|
0
|
0
|
|
|
|
|
my $cur = File::Spec->catdir(@pth); |
362
|
0
|
0
|
|
|
|
|
last if !$cur; # necessary ??? |
363
|
0
|
0
|
0
|
|
|
|
if(!shift()) { |
364
|
0
|
0
|
|
|
|
|
pathempty($cur) or return if $force; |
365
|
|
|
|
|
|
|
rmdir $cur or return; |
366
|
|
|
|
|
|
|
} |
367
|
0
|
0
|
|
|
|
|
else { |
368
|
0
|
|
|
|
|
|
pathempty($cur) if $force; |
369
|
|
|
|
|
|
|
rmdir $cur; |
370
|
0
|
|
|
|
|
|
} |
371
|
|
|
|
|
|
|
pop @pth; |
372
|
0
|
|
|
|
|
|
} |
373
|
|
|
|
|
|
|
1; |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
|
376
|
0
|
|
|
0
|
1
|
|
sub pathrmdir { |
377
|
0
|
0
|
|
|
|
|
my $dir = shift; |
378
|
0
|
0
|
|
|
|
|
if( -e $dir ) { |
379
|
|
|
|
|
|
|
return if !-d $dir; |
380
|
|
|
|
|
|
|
} |
381
|
0
|
|
|
|
|
|
else { |
382
|
|
|
|
|
|
|
return 2; |
383
|
|
|
|
|
|
|
} |
384
|
0
|
0
|
|
|
|
|
|
385
|
|
|
|
|
|
|
pathempty($dir) or return; |
386
|
0
|
0
|
|
|
|
|
|
387
|
|
|
|
|
|
|
rmdir $dir or return; |
388
|
|
|
|
|
|
|
} |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
1; |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
__END__ |