Commit | Line | Data |
1fc4cb55 |
1 | package File::Path; |
fed7345c |
2 | |
cac619e8 |
3 | use 5.005_04; |
4 | use strict; |
5 | |
6 | use Cwd 'getcwd'; |
7 | use File::Basename (); |
8 | use File::Spec (); |
9 | |
10 | BEGIN { |
11 | if ($] < 5.006) { |
12 | # can't say 'opendir my $dh, $dirname' |
13 | # need to initialise $dh |
14 | eval "use Symbol"; |
15 | } |
16 | } |
17 | |
18 | use Exporter (); |
3f083399 |
19 | use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); |
33839f2f |
20 | $VERSION = '2.07_02'; |
30cf951a |
21 | @ISA = qw(Exporter); |
22 | @EXPORT = qw(mkpath rmtree); |
3f083399 |
23 | @EXPORT_OK = qw(make_path remove_tree); |
cac619e8 |
24 | |
30cf951a |
25 | my $Is_VMS = $^O eq 'VMS'; |
26 | my $Is_MacOS = $^O eq 'MacOS'; |
cac619e8 |
27 | |
28 | # These OSes complain if you want to remove a file that you have no |
29 | # write permission to: |
351a5cfe |
30 | my $Force_Writeable = grep {$^O eq $_} qw(amigaos dos epoc MSWin32 MacOS os2); |
cac619e8 |
31 | |
32 | sub _carp { |
33 | require Carp; |
34 | goto &Carp::carp; |
35 | } |
36 | |
37 | sub _croak { |
38 | require Carp; |
39 | goto &Carp::croak; |
40 | } |
41 | |
42 | sub _error { |
43 | my $arg = shift; |
44 | my $message = shift; |
45 | my $object = shift; |
46 | |
47 | if ($arg->{error}) { |
48 | $object = '' unless defined $object; |
3f083399 |
49 | $message .= ": $!" if $!; |
50 | push @{${$arg->{error}}}, {$object => $message}; |
cac619e8 |
51 | } |
52 | else { |
53 | _carp(defined($object) ? "$message for $object: $!" : "$message: $!"); |
54 | } |
55 | } |
56 | |
3f083399 |
57 | sub make_path { |
2f9d49b4 |
58 | push @_, {} unless @_ and UNIVERSAL::isa($_[-1],'HASH'); |
3f083399 |
59 | goto &mkpath; |
60 | } |
61 | |
cac619e8 |
62 | sub mkpath { |
2f9d49b4 |
63 | my $old_style = !(@_ and UNIVERSAL::isa($_[-1],'HASH')); |
cac619e8 |
64 | |
65 | my $arg; |
66 | my $paths; |
67 | |
68 | if ($old_style) { |
69 | my ($verbose, $mode); |
70 | ($paths, $verbose, $mode) = @_; |
71 | $paths = [$paths] unless UNIVERSAL::isa($paths,'ARRAY'); |
2f9d49b4 |
72 | $arg->{verbose} = $verbose; |
30cf951a |
73 | $arg->{mode} = defined $mode ? $mode : 0777; |
cac619e8 |
74 | } |
75 | else { |
30cf951a |
76 | $arg = pop @_; |
3f083399 |
77 | $arg->{mode} = delete $arg->{mask} if exists $arg->{mask}; |
30cf951a |
78 | $arg->{mode} = 0777 unless exists $arg->{mode}; |
79 | ${$arg->{error}} = [] if exists $arg->{error}; |
cac619e8 |
80 | $paths = [@_]; |
81 | } |
82 | return _mkpath($arg, $paths); |
83 | } |
84 | |
85 | sub _mkpath { |
86 | my $arg = shift; |
87 | my $paths = shift; |
88 | |
cac619e8 |
89 | my(@created,$path); |
90 | foreach $path (@$paths) { |
3f083399 |
91 | next unless defined($path) and length($path); |
cac619e8 |
92 | $path .= '/' if $^O eq 'os2' and $path =~ /^\w:\z/s; # feature of CRT |
93 | # Logic wants Unix paths, so go with the flow. |
94 | if ($Is_VMS) { |
95 | next if $path eq '/'; |
96 | $path = VMS::Filespec::unixify($path); |
97 | } |
98 | next if -d $path; |
99 | my $parent = File::Basename::dirname($path); |
100 | unless (-d $parent or $path eq $parent) { |
101 | push(@created,_mkpath($arg, [$parent])); |
102 | } |
103 | print "mkdir $path\n" if $arg->{verbose}; |
104 | if (mkdir($path,$arg->{mode})) { |
105 | push(@created, $path); |
106 | } |
107 | else { |
108 | my $save_bang = $!; |
109 | my ($e, $e1) = ($save_bang, $^E); |
110 | $e .= "; $e1" if $e ne $e1; |
111 | # allow for another process to have created it meanwhile |
112 | if (!-d $path) { |
113 | $! = $save_bang; |
114 | if ($arg->{error}) { |
115 | push @{${$arg->{error}}}, {$path => $e}; |
116 | } |
117 | else { |
118 | _croak("mkdir $path: $e"); |
119 | } |
120 | } |
121 | } |
122 | } |
123 | return @created; |
124 | } |
125 | |
3f083399 |
126 | sub remove_tree { |
2f9d49b4 |
127 | push @_, {} unless @_ and UNIVERSAL::isa($_[-1],'HASH'); |
3f083399 |
128 | goto &rmtree; |
129 | } |
130 | |
0e5b5e32 |
131 | sub _is_subdir { |
132 | my($dir, $test) = @_; |
133 | |
134 | my($dv, $dd) = File::Spec->splitpath($dir, 1); |
135 | my($tv, $td) = File::Spec->splitpath($test, 1); |
136 | |
137 | # not on same volume |
138 | return 0 if $dv ne $tv; |
139 | |
140 | my @d = File::Spec->splitdir($dd); |
141 | my @t = File::Spec->splitdir($td); |
142 | |
143 | # @t can't be a subdir if it's shorter than @d |
144 | return 0 if @t < @d; |
145 | |
146 | return join('/', @d) eq join('/', splice @t, 0, +@d); |
147 | } |
148 | |
cac619e8 |
149 | sub rmtree { |
2f9d49b4 |
150 | my $old_style = !(@_ and UNIVERSAL::isa($_[-1],'HASH')); |
cac619e8 |
151 | |
152 | my $arg; |
153 | my $paths; |
154 | |
155 | if ($old_style) { |
156 | my ($verbose, $safe); |
157 | ($paths, $verbose, $safe) = @_; |
2f9d49b4 |
158 | $arg->{verbose} = $verbose; |
cac619e8 |
159 | $arg->{safe} = defined $safe ? $safe : 0; |
160 | |
161 | if (defined($paths) and length($paths)) { |
162 | $paths = [$paths] unless UNIVERSAL::isa($paths,'ARRAY'); |
163 | } |
164 | else { |
165 | _carp ("No root path(s) specified\n"); |
166 | return 0; |
167 | } |
168 | } |
169 | else { |
30cf951a |
170 | $arg = pop @_; |
171 | ${$arg->{error}} = [] if exists $arg->{error}; |
172 | ${$arg->{result}} = [] if exists $arg->{result}; |
cac619e8 |
173 | $paths = [@_]; |
174 | } |
175 | |
176 | $arg->{prefix} = ''; |
177 | $arg->{depth} = 0; |
178 | |
3f083399 |
179 | my @clean_path; |
cac619e8 |
180 | $arg->{cwd} = getcwd() or do { |
181 | _error($arg, "cannot fetch initial working directory"); |
182 | return 0; |
183 | }; |
184 | for ($arg->{cwd}) { /\A(.*)\Z/; $_ = $1 } # untaint |
185 | |
3f083399 |
186 | for my $p (@$paths) { |
c42ebacb |
187 | # need to fixup case and map \ to / on Windows |
188 | my $ortho_root = $^O eq 'MSWin32' ? _slash_lc($p) : $p; |
189 | my $ortho_cwd = $^O eq 'MSWin32' ? _slash_lc($arg->{cwd}) : $arg->{cwd}; |
190 | my $ortho_root_length = length($ortho_root); |
191 | $ortho_root_length-- if $^O eq 'VMS'; # don't compare '.' with ']' |
0e5b5e32 |
192 | if ($ortho_root_length && _is_subdir($ortho_root, $ortho_cwd)) { |
c42ebacb |
193 | local $! = 0; |
194 | _error($arg, "cannot remove path when cwd is $arg->{cwd}", $p); |
195 | next; |
196 | } |
197 | |
3f083399 |
198 | if ($Is_MacOS) { |
199 | $p = ":$p" unless $p =~ /:/; |
200 | $p .= ":" unless $p =~ /:\z/; |
201 | } |
202 | elsif ($^O eq 'MSWin32') { |
203 | $p =~ s{[/\\]\z}{}; |
204 | } |
205 | else { |
206 | $p =~ s{/\z}{}; |
207 | } |
208 | push @clean_path, $p; |
209 | } |
210 | |
211 | @{$arg}{qw(device inode perm)} = (lstat $arg->{cwd})[0,1] or do { |
cac619e8 |
212 | _error($arg, "cannot stat initial working directory", $arg->{cwd}); |
213 | return 0; |
214 | }; |
215 | |
3f083399 |
216 | return _rmtree($arg, \@clean_path); |
cac619e8 |
217 | } |
218 | |
219 | sub _rmtree { |
220 | my $arg = shift; |
221 | my $paths = shift; |
222 | |
223 | my $count = 0; |
224 | my $curdir = File::Spec->curdir(); |
225 | my $updir = File::Spec->updir(); |
226 | |
227 | my (@files, $root); |
228 | ROOT_DIR: |
229 | foreach $root (@$paths) { |
cac619e8 |
230 | # since we chdir into each directory, it may not be obvious |
231 | # to figure out where we are if we generate a message about |
232 | # a file name. We therefore construct a semi-canonical |
233 | # filename, anchored from the directory being unlinked (as |
234 | # opposed to being truly canonical, anchored from the root (/). |
235 | |
236 | my $canon = $arg->{prefix} |
237 | ? File::Spec->catfile($arg->{prefix}, $root) |
238 | : $root |
239 | ; |
240 | |
241 | my ($ldev, $lino, $perm) = (lstat $root)[0,1,2] or next ROOT_DIR; |
242 | |
243 | if ( -d _ ) { |
244 | $root = VMS::Filespec::pathify($root) if $Is_VMS; |
245 | if (!chdir($root)) { |
246 | # see if we can escalate privileges to get in |
247 | # (e.g. funny protection mask such as -w- instead of rwx) |
248 | $perm &= 07777; |
249 | my $nperm = $perm | 0700; |
250 | if (!($arg->{safe} or $nperm == $perm or chmod($nperm, $root))) { |
251 | _error($arg, "cannot make child directory read-write-exec", $canon); |
252 | next ROOT_DIR; |
253 | } |
254 | elsif (!chdir($root)) { |
255 | _error($arg, "cannot chdir to child", $canon); |
256 | next ROOT_DIR; |
257 | } |
258 | } |
259 | |
3f083399 |
260 | my ($cur_dev, $cur_inode, $perm) = (stat $curdir)[0,1,2] or do { |
cac619e8 |
261 | _error($arg, "cannot stat current working directory", $canon); |
262 | next ROOT_DIR; |
263 | }; |
264 | |
3f083399 |
265 | ($ldev eq $cur_dev and $lino eq $cur_inode) |
266 | or _croak("directory $canon changed before chdir, expected dev=$ldev ino=$lino, actual dev=$cur_dev ino=$cur_inode, aborting."); |
cac619e8 |
267 | |
268 | $perm &= 07777; # don't forget setuid, setgid, sticky bits |
269 | my $nperm = $perm | 0700; |
270 | |
271 | # notabene: 0700 is for making readable in the first place, |
272 | # it's also intended to change it to writable in case we have |
273 | # to recurse in which case we are better than rm -rf for |
274 | # subtrees with strange permissions |
275 | |
276 | if (!($arg->{safe} or $nperm == $perm or chmod($nperm, $curdir))) { |
277 | _error($arg, "cannot make directory read+writeable", $canon); |
278 | $nperm = $perm; |
279 | } |
280 | |
281 | my $d; |
282 | $d = gensym() if $] < 5.006; |
283 | if (!opendir $d, $curdir) { |
284 | _error($arg, "cannot opendir", $canon); |
285 | @files = (); |
286 | } |
287 | else { |
288 | no strict 'refs'; |
289 | if (!defined ${"\cTAINT"} or ${"\cTAINT"}) { |
290 | # Blindly untaint dir names if taint mode is |
291 | # active, or any perl < 5.006 |
292 | @files = map { /\A(.*)\z/s; $1 } readdir $d; |
293 | } |
294 | else { |
295 | @files = readdir $d; |
296 | } |
297 | closedir $d; |
298 | } |
299 | |
300 | if ($Is_VMS) { |
301 | # Deleting large numbers of files from VMS Files-11 |
302 | # filesystems is faster if done in reverse ASCIIbetical order. |
303 | # include '.' to '.;' from blead patch #31775 |
304 | @files = map {$_ eq '.' ? '.;' : $_} reverse @files; |
305 | ($root = VMS::Filespec::unixify($root)) =~ s/\.dir\z//; |
306 | } |
307 | @files = grep {$_ ne $updir and $_ ne $curdir} @files; |
308 | |
309 | if (@files) { |
310 | # remove the contained files before the directory itself |
311 | my $narg = {%$arg}; |
312 | @{$narg}{qw(device inode cwd prefix depth)} |
3f083399 |
313 | = ($cur_dev, $cur_inode, $updir, $canon, $arg->{depth}+1); |
cac619e8 |
314 | $count += _rmtree($narg, \@files); |
315 | } |
316 | |
317 | # restore directory permissions of required now (in case the rmdir |
318 | # below fails), while we are still in the directory and may do so |
319 | # without a race via '.' |
320 | if ($nperm != $perm and not chmod($perm, $curdir)) { |
321 | _error($arg, "cannot reset chmod", $canon); |
322 | } |
323 | |
324 | # don't leave the client code in an unexpected directory |
325 | chdir($arg->{cwd}) |
326 | or _croak("cannot chdir to $arg->{cwd} from $canon: $!, aborting."); |
327 | |
328 | # ensure that a chdir upwards didn't take us somewhere other |
329 | # than we expected (see CVE-2002-0435) |
3f083399 |
330 | ($cur_dev, $cur_inode) = (stat $curdir)[0,1] |
cac619e8 |
331 | or _croak("cannot stat prior working directory $arg->{cwd}: $!, aborting."); |
332 | |
3f083399 |
333 | ($arg->{device} eq $cur_dev and $arg->{inode} eq $cur_inode) |
334 | or _croak("previous directory $arg->{cwd} changed before entering $canon, expected dev=$ldev ino=$lino, actual dev=$cur_dev ino=$cur_inode, aborting."); |
cac619e8 |
335 | |
336 | if ($arg->{depth} or !$arg->{keep_root}) { |
337 | if ($arg->{safe} && |
338 | ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) { |
339 | print "skipped $root\n" if $arg->{verbose}; |
340 | next ROOT_DIR; |
341 | } |
3f083399 |
342 | if ($Force_Writeable and !chmod $perm | 0700, $root) { |
30cf951a |
343 | _error($arg, "cannot make directory writeable", $canon); |
344 | } |
cac619e8 |
345 | print "rmdir $root\n" if $arg->{verbose}; |
346 | if (rmdir $root) { |
347 | push @{${$arg->{result}}}, $root if $arg->{result}; |
348 | ++$count; |
349 | } |
350 | else { |
351 | _error($arg, "cannot remove directory", $canon); |
21070700 |
352 | if ($Force_Writeable && !chmod($perm, ($Is_VMS ? VMS::Filespec::fileify($root) : $root)) |
cac619e8 |
353 | ) { |
354 | _error($arg, sprintf("cannot restore permissions to 0%o",$perm), $canon); |
355 | } |
356 | } |
357 | } |
358 | } |
359 | else { |
360 | # not a directory |
cac619e8 |
361 | $root = VMS::Filespec::vmsify("./$root") |
30cf951a |
362 | if $Is_VMS |
8b0a9f85 |
363 | && !File::Spec->file_name_is_absolute($root) |
364 | && ($root !~ m/(?<!\^)[\]>]+/); # not already in VMS syntax |
cac619e8 |
365 | |
366 | if ($arg->{safe} && |
367 | ($Is_VMS ? !&VMS::Filespec::candelete($root) |
368 | : !(-l $root || -w $root))) |
369 | { |
370 | print "skipped $root\n" if $arg->{verbose}; |
371 | next ROOT_DIR; |
372 | } |
373 | |
374 | my $nperm = $perm & 07777 | 0600; |
3f083399 |
375 | if ($Force_Writeable and $nperm != $perm and not chmod $nperm, $root) { |
30cf951a |
376 | _error($arg, "cannot make file writeable", $canon); |
377 | } |
cac619e8 |
378 | print "unlink $canon\n" if $arg->{verbose}; |
379 | # delete all versions under VMS |
380 | for (;;) { |
381 | if (unlink $root) { |
382 | push @{${$arg->{result}}}, $root if $arg->{result}; |
383 | } |
384 | else { |
385 | _error($arg, "cannot unlink file", $canon); |
386 | $Force_Writeable and chmod($perm, $root) or |
387 | _error($arg, sprintf("cannot restore permissions to 0%o",$perm), $canon); |
388 | last; |
389 | } |
390 | ++$count; |
391 | last unless $Is_VMS && lstat $root; |
392 | } |
393 | } |
394 | } |
cac619e8 |
395 | return $count; |
396 | } |
397 | |
3f083399 |
398 | sub _slash_lc { |
399 | # fix up slashes and case on MSWin32 so that we can determine that |
400 | # c:\path\to\dir is underneath C:/Path/To |
401 | my $path = shift; |
402 | $path =~ tr{\\}{/}; |
403 | return lc($path); |
404 | } |
405 | |
cac619e8 |
406 | 1; |
407 | __END__ |
408 | |
fed7345c |
409 | =head1 NAME |
410 | |
12c2e016 |
411 | File::Path - Create or remove directory trees |
412 | |
413 | =head1 VERSION |
414 | |
867b93c3 |
415 | This document describes version 2.07 of File::Path, released |
416 | 2008-11-09. |
fed7345c |
417 | |
418 | =head1 SYNOPSIS |
419 | |
2f9d49b4 |
420 | use File::Path qw(make_path remove_tree); |
fed7345c |
421 | |
2f9d49b4 |
422 | make_path('foo/bar/baz', '/zug/zwang'); |
423 | make_path('foo/bar/baz', '/zug/zwang', { |
424 | verbose => 1, |
425 | mode => 0711, |
426 | }); |
12c2e016 |
427 | |
2f9d49b4 |
428 | remove_tree('foo/bar/baz', '/zug/zwang'); |
429 | remove_tree('foo/bar/baz', '/zug/zwang', { |
430 | verbose => 1, |
431 | error => \my $err_list, |
432 | }); |
12c2e016 |
433 | |
30cf951a |
434 | # legacy (interface promoted before v2.00) |
2f9d49b4 |
435 | mkpath('/foo/bar/baz'); |
436 | mkpath('/foo/bar/baz', 1, 0711); |
30cf951a |
437 | mkpath(['/foo/bar/baz', 'blurfl/quux'], 1, 0711); |
2f9d49b4 |
438 | rmtree('foo/bar/baz', 1, 1); |
30cf951a |
439 | rmtree(['foo/bar/baz', 'blurfl/quux'], 1, 1); |
fed7345c |
440 | |
30cf951a |
441 | # legacy (interface promoted before v2.06) |
2f9d49b4 |
442 | mkpath('foo/bar/baz', '/zug/zwang', { verbose => 1, mode => 0711 }); |
443 | rmtree('foo/bar/baz', '/zug/zwang', { verbose => 1, mode => 0711 }); |
12c2e016 |
444 | |
2f9d49b4 |
445 | =head1 DESCRIPTION |
12c2e016 |
446 | |
2f9d49b4 |
447 | This module provide a convenient way to create directories of |
448 | arbitrary depth and to delete an entire directory subtree from the |
449 | filesystem. |
3f083399 |
450 | |
2f9d49b4 |
451 | The following functions are provided: |
3f083399 |
452 | |
2f9d49b4 |
453 | =over |
12c2e016 |
454 | |
2f9d49b4 |
455 | =item make_path( $dir1, $dir2, .... ) |
12c2e016 |
456 | |
2f9d49b4 |
457 | =item make_path( $dir1, $dir2, ...., \%opts ) |
3f083399 |
458 | |
2f9d49b4 |
459 | The C<make_path> function creates the given directories if they don't |
460 | exists before, much like the Unix command C<mkdir -p>. |
3f083399 |
461 | |
2f9d49b4 |
462 | The function accepts a list of directories to be created. Its |
463 | behaviour may be tuned by an optional hashref appearing as the last |
464 | parameter on the call. |
12c2e016 |
465 | |
3f083399 |
466 | The function returns the list of directories actually created during |
2f9d49b4 |
467 | the call; in scalar context the number of directories created. |
3f083399 |
468 | |
2f9d49b4 |
469 | The following keys are recognised in the option hash: |
3f083399 |
470 | |
2f9d49b4 |
471 | =over |
12c2e016 |
472 | |
2f9d49b4 |
473 | =item mode => $num |
12c2e016 |
474 | |
0b3d36bd |
475 | The numeric permissions mode to apply to each created directory |
476 | (defaults to 0777), to be modified by the current C<umask>. If the |
477 | directory already exists (and thus does not need to be created), |
478 | the permissions will not be modified. |
479 | |
480 | C<mask> is recognised as an alias for this parameter. |
12c2e016 |
481 | |
2f9d49b4 |
482 | =item verbose => $bool |
12c2e016 |
483 | |
30cf951a |
484 | If present, will cause C<make_path> to print the name of each directory |
12c2e016 |
485 | as it is created. By default nothing is printed. |
486 | |
2f9d49b4 |
487 | =item error => \$err |
12c2e016 |
488 | |
2f9d49b4 |
489 | If present, it should be a reference to a scalar. |
490 | This scalar will be made to reference an array, which will |
867b93c3 |
491 | be used to store any errors that are encountered. See the L</"ERROR |
492 | HANDLING"> section for more information. |
12c2e016 |
493 | |
0b3d36bd |
494 | If this parameter is not used, certain error conditions may raise |
495 | a fatal error that will cause the program will halt, unless trapped |
496 | in an C<eval> block. |
12c2e016 |
497 | |
498 | =back |
499 | |
30cf951a |
500 | =item mkpath( $dir ) |
501 | |
2f9d49b4 |
502 | =item mkpath( $dir, $verbose, $mode ) |
3f083399 |
503 | |
2f9d49b4 |
504 | =item mkpath( [$dir1, $dir2,...], $verbose, $mode ) |
3f083399 |
505 | |
2f9d49b4 |
506 | =item mkpath( $dir1, $dir2,..., \%opt ) |
3f083399 |
507 | |
867b93c3 |
508 | The mkpath() function provide the legacy interface of make_path() with |
509 | a different interpretation of the arguments passed. The behaviour and |
510 | return value of the function is otherwise identical to make_path(). |
12c2e016 |
511 | |
2f9d49b4 |
512 | =item remove_tree( $dir1, $dir2, .... ) |
3f083399 |
513 | |
2f9d49b4 |
514 | =item remove_tree( $dir1, $dir2, ...., \%opts ) |
3f083399 |
515 | |
2f9d49b4 |
516 | The C<remove_tree> function deletes the given directories and any |
517 | files and subdirectories they might contain, much like the Unix |
518 | command C<rm -r> or C<del /s> on Windows. |
12c2e016 |
519 | |
2f9d49b4 |
520 | The function accepts a list of directories to be |
521 | removed. Its behaviour may be tuned by an optional hashref |
522 | appearing as the last parameter on the call. |
523 | |
524 | The functions returns the number of files successfully deleted. |
525 | |
526 | The following keys are recognised in the option hash: |
527 | |
528 | =over |
529 | |
530 | =item verbose => $bool |
12c2e016 |
531 | |
30cf951a |
532 | If present, will cause C<remove_tree> to print the name of each file as |
12c2e016 |
533 | it is unlinked. By default nothing is printed. |
534 | |
2f9d49b4 |
535 | =item safe => $bool |
12c2e016 |
536 | |
30cf951a |
537 | When set to a true value, will cause C<remove_tree> to skip the files |
0b3d36bd |
538 | for which the process lacks the required privileges needed to delete |
5808899a |
539 | files, such as delete privileges on VMS. In other words, the code |
540 | will make no attempt to alter file permissions. Thus, if the process |
541 | is interrupted, no filesystem object will be left in a more |
542 | permissive mode. |
12c2e016 |
543 | |
2f9d49b4 |
544 | =item keep_root => $bool |
12c2e016 |
545 | |
0b3d36bd |
546 | When set to a true value, will cause all files and subdirectories |
547 | to be removed, except the initially specified directories. This comes |
548 | in handy when cleaning out an application's scratch directory. |
12c2e016 |
549 | |
3f083399 |
550 | remove_tree( '/tmp', {keep_root => 1} ); |
12c2e016 |
551 | |
2f9d49b4 |
552 | =item result => \$res |
12c2e016 |
553 | |
2f9d49b4 |
554 | If present, it should be a reference to a scalar. |
555 | This scalar will be made to reference an array, which will |
556 | be used to store all files and directories unlinked |
867b93c3 |
557 | during the call. If nothing is unlinked, the array will be empty. |
12c2e016 |
558 | |
3f083399 |
559 | remove_tree( '/tmp', {result => \my $list} ); |
12c2e016 |
560 | print "unlinked $_\n" for @$list; |
561 | |
0b3d36bd |
562 | This is a useful alternative to the C<verbose> key. |
563 | |
2f9d49b4 |
564 | =item error => \$err |
12c2e016 |
565 | |
2f9d49b4 |
566 | If present, it should be a reference to a scalar. |
567 | This scalar will be made to reference an array, which will |
867b93c3 |
568 | be used to store any errors that are encountered. See the L</"ERROR |
569 | HANDLING"> section for more information. |
12c2e016 |
570 | |
0b3d36bd |
571 | Removing things is a much more dangerous proposition than |
572 | creating things. As such, there are certain conditions that |
30cf951a |
573 | C<remove_tree> may encounter that are so dangerous that the only |
0b3d36bd |
574 | sane action left is to kill the program. |
575 | |
576 | Use C<error> to trap all that is reasonable (problems with |
577 | permissions and the like), and let it die if things get out |
578 | of hand. This is the safest course of action. |
12c2e016 |
579 | |
580 | =back |
581 | |
2f9d49b4 |
582 | =item rmtree( $dir ) |
fed7345c |
583 | |
2f9d49b4 |
584 | =item rmtree( $dir, $verbose, $safe ) |
fed7345c |
585 | |
2f9d49b4 |
586 | =item rmtree( [$dir1, $dir2,...], $verbose, $safe ) |
fed7345c |
587 | |
2f9d49b4 |
588 | =item rmtree( $dir1, $dir2,..., \%opt ) |
fed7345c |
589 | |
867b93c3 |
590 | The rmtree() function provide the legacy interface of remove_tree() |
591 | with a different interpretation of the arguments passed. The behaviour |
592 | and return value of the function is otherwise identical to |
593 | remove_tree(). |
fed7345c |
594 | |
595 | =back |
596 | |
12c2e016 |
597 | =head2 ERROR HANDLING |
598 | |
30cf951a |
599 | =over 4 |
600 | |
601 | =item B<NOTE:> |
602 | |
603 | The following error handling mechanism is considered |
604 | experimental and is subject to change pending feedback from |
605 | users. |
606 | |
607 | =back |
608 | |
609 | If C<make_path> or C<remove_tree> encounter an error, a diagnostic |
610 | message will be printed to C<STDERR> via C<carp> (for non-fatal |
611 | errors), or via C<croak> (for fatal errors). |
12c2e016 |
612 | |
613 | If this behaviour is not desirable, the C<error> attribute may be |
614 | used to hold a reference to a variable, which will be used to store |
867b93c3 |
615 | the diagnostics. The variable is made a reference to an array of hash |
616 | references. Each hash contain a single key/value pair where the key |
617 | is the name of the file, and the value is the error message (including |
618 | the contents of C<$!> when appropriate). If a general error is |
619 | encountered the diagnostic key will be empty. |
620 | |
621 | An example usage looks like: |
12c2e016 |
622 | |
3f083399 |
623 | remove_tree( 'foo/bar', 'bar/rat', {error => \my $err} ); |
867b93c3 |
624 | if (@$err) { |
625 | for my $diag (@$err) { |
626 | my ($file, $message) = %$diag; |
627 | if ($file eq '') { |
628 | print "general error: $message\n"; |
629 | } |
630 | else { |
631 | print "problem unlinking $file: $message\n"; |
632 | } |
633 | } |
12c2e016 |
634 | } |
867b93c3 |
635 | else { |
636 | print "No error encountered\n"; |
12c2e016 |
637 | } |
638 | |
867b93c3 |
639 | Note that if no errors are encountered, C<$err> will reference an |
640 | empty array. This means that C<$err> will always end up TRUE; so you |
641 | need to test C<@$err> to determine if errors occured. |
642 | |
12c2e016 |
643 | =head2 NOTES |
644 | |
0b3d36bd |
645 | C<File::Path> blindly exports C<mkpath> and C<rmtree> into the |
646 | current namespace. These days, this is considered bad style, but |
647 | to change it now would break too much code. Nonetheless, you are |
648 | invited to specify what it is you are expecting to use: |
649 | |
650 | use File::Path 'rmtree'; |
651 | |
3f083399 |
652 | The routines C<make_path> and C<remove_tree> are B<not> exported |
653 | by default. You must specify which ones you want to use. |
e2ba98a1 |
654 | |
3f083399 |
655 | use File::Path 'remove_tree'; |
e2ba98a1 |
656 | |
3f083399 |
657 | Note that a side-effect of the above is that C<mkpath> and C<rmtree> |
658 | are no longer exported at all. This is due to the way the C<Exporter> |
659 | module works. If you are migrating a codebase to use the new |
660 | interface, you will have to list everything explicitly. But that's |
661 | just good practice anyway. |
12c2e016 |
662 | |
3f083399 |
663 | use File::Path qw(remove_tree rmtree); |
12c2e016 |
664 | |
0b3d36bd |
665 | =head3 SECURITY CONSIDERATIONS |
12c2e016 |
666 | |
0b3d36bd |
667 | There were race conditions 1.x implementations of File::Path's |
668 | C<rmtree> function (although sometimes patched depending on the OS |
669 | distribution or platform). The 2.0 version contains code to avoid the |
670 | problem mentioned in CVE-2002-0435. |
12c2e016 |
671 | |
0b3d36bd |
672 | See the following pages for more information: |
12c2e016 |
673 | |
0b3d36bd |
674 | http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=286905 |
675 | http://www.nntp.perl.org/group/perl.perl5.porters/2005/01/msg97623.html |
676 | http://www.debian.org/security/2005/dsa-696 |
12c2e016 |
677 | |
5808899a |
678 | Additionally, unless the C<safe> parameter is set (or the |
37b1cd44 |
679 | third parameter in the traditional interface is TRUE), should a |
30cf951a |
680 | C<remove_tree> be interrupted, files that were originally in read-only |
0b3d36bd |
681 | mode may now have their permissions set to a read-write (or "delete |
682 | OK") mode. |
96e4d5b1 |
683 | |
b8d5f521 |
684 | =head1 DIAGNOSTICS |
685 | |
0b3d36bd |
686 | FATAL errors will cause the program to halt (C<croak>), since the |
687 | problem is so severe that it would be dangerous to continue. (This |
688 | can always be trapped with C<eval>, but it's not a good idea. Under |
689 | the circumstances, dying is the best thing to do). |
690 | |
691 | SEVERE errors may be trapped using the modern interface. If the |
692 | they are not trapped, or the old interface is used, such an error |
693 | will cause the program will halt. |
694 | |
695 | All other errors may be trapped using the modern interface, otherwise |
696 | they will be C<carp>ed about. Program execution will not be halted. |
697 | |
b8d5f521 |
698 | =over 4 |
699 | |
37b1cd44 |
700 | =item mkdir [path]: [errmsg] (SEVERE) |
0b3d36bd |
701 | |
867b93c3 |
702 | C<make_path> was unable to create the path. Probably some sort of |
0b3d36bd |
703 | permissions error at the point of departure, or insufficient resources |
704 | (such as free inodes on Unix). |
705 | |
706 | =item No root path(s) specified |
707 | |
867b93c3 |
708 | C<make_path> was not given any paths to create. This message is only |
0b3d36bd |
709 | emitted if the routine is called with the traditional interface. |
710 | The modern interface will remain silent if given nothing to do. |
711 | |
712 | =item No such file or directory |
713 | |
867b93c3 |
714 | On Windows, if C<make_path> gives you this warning, it may mean that |
0b3d36bd |
715 | you have exceeded your filesystem's maximum path length. |
716 | |
717 | =item cannot fetch initial working directory: [errmsg] |
718 | |
30cf951a |
719 | C<remove_tree> attempted to determine the initial directory by calling |
0b3d36bd |
720 | C<Cwd::getcwd>, but the call failed for some reason. No attempt |
721 | will be made to delete anything. |
722 | |
723 | =item cannot stat initial working directory: [errmsg] |
724 | |
30cf951a |
725 | C<remove_tree> attempted to stat the initial directory (after having |
0b3d36bd |
726 | successfully obtained its name via C<getcwd>), however, the call |
727 | failed for some reason. No attempt will be made to delete anything. |
728 | |
729 | =item cannot chdir to [dir]: [errmsg] |
730 | |
30cf951a |
731 | C<remove_tree> attempted to set the working directory in order to |
0b3d36bd |
732 | begin deleting the objects therein, but was unsuccessful. This is |
733 | usually a permissions issue. The routine will continue to delete |
734 | other things, but this directory will be left intact. |
735 | |
3f083399 |
736 | =item directory [dir] changed before chdir, expected dev=[n] ino=[n], actual dev=[n] ino=[n], aborting. (FATAL) |
0b3d36bd |
737 | |
30cf951a |
738 | C<remove_tree> recorded the device and inode of a directory, and then |
0b3d36bd |
739 | moved into it. It then performed a C<stat> on the current directory |
740 | and detected that the device and inode were no longer the same. As |
741 | this is at the heart of the race condition problem, the program |
742 | will die at this point. |
743 | |
744 | =item cannot make directory [dir] read+writeable: [errmsg] |
745 | |
30cf951a |
746 | C<remove_tree> attempted to change the permissions on the current directory |
0b3d36bd |
747 | to ensure that subsequent unlinkings would not run into problems, |
748 | but was unable to do so. The permissions remain as they were, and |
749 | the program will carry on, doing the best it can. |
750 | |
751 | =item cannot read [dir]: [errmsg] |
752 | |
30cf951a |
753 | C<remove_tree> tried to read the contents of the directory in order |
0b3d36bd |
754 | to acquire the names of the directory entries to be unlinked, but |
755 | was unsuccessful. This is usually a permissions issue. The |
756 | program will continue, but the files in this directory will remain |
757 | after the call. |
758 | |
759 | =item cannot reset chmod [dir]: [errmsg] |
760 | |
30cf951a |
761 | C<remove_tree>, after having deleted everything in a directory, attempted |
cac619e8 |
762 | to restore its permissions to the original state but failed. The |
763 | directory may wind up being left behind. |
12c2e016 |
764 | |
c42ebacb |
765 | =item cannot remove [dir] when cwd is [dir] |
766 | |
767 | The current working directory of the program is F</some/path/to/here> |
768 | and you are attempting to remove an ancestor, such as F</some/path>. |
769 | The directory tree is left untouched. |
770 | |
771 | The solution is to C<chdir> out of the child directory to a place |
772 | outside the directory tree to be removed. |
773 | |
cac619e8 |
774 | =item cannot chdir to [parent-dir] from [child-dir]: [errmsg], aborting. (FATAL) |
12c2e016 |
775 | |
30cf951a |
776 | C<remove_tree>, after having deleted everything and restored the permissions |
3f083399 |
777 | of a directory, was unable to chdir back to the parent. The program |
778 | halts to avoid a race condition from occurring. |
fed7345c |
779 | |
cac619e8 |
780 | =item cannot stat prior working directory [dir]: [errmsg], aborting. (FATAL) |
0b3d36bd |
781 | |
30cf951a |
782 | C<remove_tree> was unable to stat the parent directory after have returned |
cac619e8 |
783 | from the child. Since there is no way of knowing if we returned to |
784 | where we think we should be (by comparing device and inode) the only |
785 | way out is to C<croak>. |
0b3d36bd |
786 | |
3f083399 |
787 | =item previous directory [parent-dir] changed before entering [child-dir], expected dev=[n] ino=[n], actual dev=[n] ino=[n], aborting. (FATAL) |
0b3d36bd |
788 | |
30cf951a |
789 | When C<remove_tree> returned from deleting files in a child directory, a |
cac619e8 |
790 | check revealed that the parent directory it returned to wasn't the one |
791 | it started out from. This is considered a sign of malicious activity. |
0b3d36bd |
792 | |
cac619e8 |
793 | =item cannot make directory [dir] writeable: [errmsg] |
ee79a11f |
794 | |
cac619e8 |
795 | Just before removing a directory (after having successfully removed |
30cf951a |
796 | everything it contained), C<remove_tree> attempted to set the permissions |
cac619e8 |
797 | on the directory to ensure it could be removed and failed. Program |
798 | execution continues, but the directory may possibly not be deleted. |
0b3d36bd |
799 | |
cac619e8 |
800 | =item cannot remove directory [dir]: [errmsg] |
0b3d36bd |
801 | |
30cf951a |
802 | C<remove_tree> attempted to remove a directory, but failed. This may because |
cac619e8 |
803 | some objects that were unable to be removed remain in the directory, or |
804 | a permissions issue. The directory will be left behind. |
0b3d36bd |
805 | |
cac619e8 |
806 | =item cannot restore permissions of [dir] to [0nnn]: [errmsg] |
0b3d36bd |
807 | |
30cf951a |
808 | After having failed to remove a directory, C<remove_tree> was unable to |
cac619e8 |
809 | restore its permissions from a permissive state back to a possibly |
810 | more restrictive setting. (Permissions given in octal). |
0b3d36bd |
811 | |
cac619e8 |
812 | =item cannot make file [file] writeable: [errmsg] |
b5400373 |
813 | |
30cf951a |
814 | C<remove_tree> attempted to force the permissions of a file to ensure it |
cac619e8 |
815 | could be deleted, but failed to do so. It will, however, still attempt |
816 | to unlink the file. |
0b3d36bd |
817 | |
cac619e8 |
818 | =item cannot unlink file [file]: [errmsg] |
0b3d36bd |
819 | |
30cf951a |
820 | C<remove_tree> failed to remove a file. Probably a permissions issue. |
0b3d36bd |
821 | |
cac619e8 |
822 | =item cannot restore permissions of [file] to [0nnn]: [errmsg] |
0b3d36bd |
823 | |
30cf951a |
824 | After having failed to remove a file, C<remove_tree> was also unable |
cac619e8 |
825 | to restore the permissions on the file to a possibly less permissive |
826 | setting. (Permissions given in octal). |
0b3d36bd |
827 | |
cac619e8 |
828 | =back |
12c2e016 |
829 | |
cac619e8 |
830 | =head1 SEE ALSO |
037c8c09 |
831 | |
cac619e8 |
832 | =over 4 |
0b3d36bd |
833 | |
cac619e8 |
834 | =item * |
0b3d36bd |
835 | |
351a5cfe |
836 | L<File::Remove> |
837 | |
838 | Allows files and directories to be moved to the Trashcan/Recycle |
839 | Bin (where they may later be restored if necessary) if the operating |
840 | system supports such functionality. This feature may one day be |
841 | made available directly in C<File::Path>. |
842 | |
843 | =item * |
844 | |
cac619e8 |
845 | L<File::Find::Rule> |
0b3d36bd |
846 | |
cac619e8 |
847 | When removing directory trees, if you want to examine each file to |
848 | decide whether to delete it (and possibly leaving large swathes |
849 | alone), F<File::Find::Rule> offers a convenient and flexible approach |
850 | to examining directory trees. |
0b3d36bd |
851 | |
cac619e8 |
852 | =back |
0b3d36bd |
853 | |
cac619e8 |
854 | =head1 BUGS |
0b3d36bd |
855 | |
cac619e8 |
856 | Please report all bugs on the RT queue: |
b5400373 |
857 | |
cac619e8 |
858 | L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=File-Path> |
b5400373 |
859 | |
cac619e8 |
860 | =head1 ACKNOWLEDGEMENTS |
0b3d36bd |
861 | |
cac619e8 |
862 | Paul Szabo identified the race condition originally, and Brendan |
863 | O'Dea wrote an implementation for Debian that addressed the problem. |
864 | That code was used as a basis for the current code. Their efforts |
865 | are greatly appreciated. |
fed7345c |
866 | |
867b93c3 |
867 | Gisle Aas made a number of improvements to the documentation for |
868 | 2.07 and his advice and assistance is also greatly appreciated. |
869 | |
cac619e8 |
870 | =head1 AUTHORS |
fed7345c |
871 | |
3f083399 |
872 | Tim Bunce and Charles Bailey. Currently maintained by David Landgren |
cac619e8 |
873 | <F<david@landgren.net>>. |
874 | |
875 | =head1 COPYRIGHT |
876 | |
877 | This module is copyright (C) Charles Bailey, Tim Bunce and |
3f083399 |
878 | David Landgren 1995-2008. All rights reserved. |
cac619e8 |
879 | |
880 | =head1 LICENSE |
881 | |
882 | This library is free software; you can redistribute it and/or modify |
883 | it under the same terms as Perl itself. |
884 | |
885 | =cut |