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