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