lib/File/Path.pm

   1 package File::Path;
   2
   3 =head1 NAME
   4
   5 File::Path - create or remove directory trees
   6
   7 =head1 SYNOPSIS
   8
   9     use File::Path;
  10
  11     mkpath(['/foo/bar/baz', 'blurfl/quux'], 1, 0711);
  12     rmtree(['foo/bar/baz', 'blurfl/quux'], 1, 1);
  13
  14 =head1 DESCRIPTION
  15
  16 The C<mkpath> function provides a convenient way to create directories, even
  17 if your C<mkdir> kernel call won't create more than one level of directory at
  18 a time.  C<mkpath> takes three arguments:
  19
  20 =over 4
  21
  22 =item *
  23
  24 the name of the path to create, or a reference
  25 to a list of paths to create,
  26
  27 =item *
  28
  29 a boolean value, which if TRUE will cause C<mkpath>
  30 to print the name of each directory as it is created
  31 (defaults to FALSE), and
  32
  33 =item *
  34
  35 the numeric mode to use when creating the directories
  36 (defaults to 0777), to be modified by the current umask.
  37
  38 =back
  39
  40 It returns a list of all directories (including intermediates, determined
  41 using the Unix '/' separator) created.
  42
  43 If a system error prevents a directory from being created, then the
  44 C<mkpath> function throws a fatal error with C<Carp::croak>. This error
  45 can be trapped with an C<eval> block:
  46
  47   eval { mkpath($dir) };
  48   if ($@) {
  49     print "Couldn't create $dir: $@";
  50   }
  51
  52 Similarly, the C<rmtree> function provides a convenient way to delete a
  53 subtree from the directory structure, much like the Unix command C<rm -r>.
  54 C<rmtree> takes three arguments:
  55
  56 =over 4
  57
  58 =item *
  59
  60 the root of the subtree to delete, or a reference to
  61 a list of roots.  All of the files and directories
  62 below each root, as well as the roots themselves,
  63 will be deleted.
  64
  65 =item *
  66
  67 a boolean value, which if TRUE will cause C<rmtree> to
  68 print a message each time it examines a file, giving the
  69 name of the file, and indicating whether it's using C<rmdir>
  70 or C<unlink> to remove it, or that it's skipping it.
  71 (defaults to FALSE)
  72
  73 =item *
  74
  75 a boolean value, which if TRUE will cause C<rmtree> to
  76 skip any files to which you do not have delete access
  77 (if running under VMS) or write access (if running
  78 under another OS).  This will change in the future when
  79 a criterion for 'delete permission' under OSs other
  80 than VMS is settled.  (defaults to FALSE)
  81
  82 =back
  83
  84 It returns the number of files successfully deleted.  Symlinks are
  85 simply deleted and not followed.
  86
  87 B<NOTE:> There are race conditions internal to the implementation of
  88 C<rmtree> making it unsafe to use on directory trees which may be
  89 altered or moved while C<rmtree> is running, and in particular on any
  90 directory trees with any path components or subdirectories potentially
  91 writable by untrusted users.
  92
  93 Additionally, if the third parameter is not TRUE and C<rmtree> is
  94 interrupted, it may leave files and directories with permissions altered
  95 to allow deletion (and older versions of this module would even set
  96 files and directories to world-read/writable!)
  97
  98 Note also that the occurrence of errors in C<rmtree> can be determined I<only>
  99 by trapping diagnostic messages using C<$SIG{__WARN__}>; it is not apparent
 100 from the return value.
 101
 102 =head1 DIAGNOSTICS
 103
 104 =over 4
 105
 106 =item *
 107
 108 On Windows, if C<mkpath> gives you the warning: B<No such file or
 109 directory>, this may mean that you've exceeded your filesystem's
 110 maximum path length.
 111
 112 =back
 113
 114 =head1 AUTHORS
 115
 116 Tim Bunce <F<Tim.Bunce@ig.co.uk>> and
 117 Charles Bailey <F<bailey@newman.upenn.edu>>
 118
 119 =cut
 120
 121 use 5.006;
 122 use Carp;
 123 use File::Basename ();
 124 use Exporter ();
 125 use strict;
 126 use warnings;
 127
 128 our $VERSION = "1.07";
 129 our @ISA = qw( Exporter );
 130 our @EXPORT = qw( mkpath rmtree );
 131
 132 my $Is_VMS = $^O eq 'VMS';
 133 my $Is_MacOS = $^O eq 'MacOS';
 134
 135 # These OSes complain if you want to remove a file that you have no
 136 # write permission to:
 137 my $force_writeable = ($^O eq 'os2' || $^O eq 'dos' || $^O eq 'MSWin32' ||
 138                        $^O eq 'amigaos' || $^O eq 'MacOS' || $^O eq 'epoc');
 139
 140 sub mkpath {
 141     my($paths, $verbose, $mode) = @_;
 142     # $paths   -- either a path string or ref to list of paths
 143     # $verbose -- optional print "mkdir $path" for each directory created
 144     # $mode    -- optional permissions, defaults to 0777
 145     local($")=$Is_MacOS ? ":" : "/";
 146     $mode = 0777 unless defined($mode);
 147     $paths = [$paths] unless ref $paths;
 148     my(@created,$path);
 149     foreach $path (@$paths) {
 150         $path .= '/' if $^O eq 'os2' and $path =~ /^\w:\z/s; # feature of CRT
 151         # Logic wants Unix paths, so go with the flow.
 152         if ($Is_VMS) {
 153             next if $path eq '/';
 154             $path = VMS::Filespec::unixify($path);
 155             if ($path =~ m:^(/[^/]+)/?\z:) {
 156                 $path = $1.'/000000';
 157             }
 158         }
 159         next if -d $path;
 160         my $parent = File::Basename::dirname($path);
 161         unless (-d $parent or $path eq $parent) {
 162             push(@created,mkpath($parent, $verbose, $mode));
 163         }
 164         print "mkdir $path\n" if $verbose;
 165         unless (mkdir($path,$mode)) {
 166             my $e = $!;
 167             # allow for another process to have created it meanwhile
 168             croak "mkdir $path: $e" unless -d $path;
 169         }
 170         push(@created, $path);
 171     }
 172     @created;
 173 }
 174
 175 sub rmtree {
 176     my($roots, $verbose, $safe) = @_;
 177     my(@files);
 178     my($count) = 0;
 179     $verbose ||= 0;
 180     $safe ||= 0;
 181
 182     if ( defined($roots) && length($roots) ) {
 183       $roots = [$roots] unless ref $roots;
 184     }
 185     else {
 186       carp "No root path(s) specified\n";
 187       return 0;
 188     }
 189
 190     my($root);
 191     foreach $root (@{$roots}) {
 192         if ($Is_MacOS) {
 193             $root = ":$root" if $root !~ /:/;
 194             $root =~ s#([^:])\z#$1:#;
 195         } else {
 196             $root =~ s#/\z##;
 197         }
 198         (undef, undef, my $rp) = lstat $root or next;
 199         $rp &= 07777;   # don't forget setuid, setgid, sticky bits
 200         if ( -d _ ) {
 201             # notabene: 0700 is for making readable in the first place,
 202             # it's also intended to change it to writable in case we have
 203             # to recurse in which case we are better than rm -rf for
 204             # subtrees with strange permissions
 205             chmod($rp | 0700, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
 206               or carp "Can't make directory $root read+writeable: $!"
 207                 unless $safe;
 208
 209             if (opendir my $d, $root) {
 210                 no strict 'refs';
 211                 if (!defined ${"\cTAINT"} or ${"\cTAINT"}) {
 212                     # Blindly untaint dir names
 213                     @files = map { /^(.*)$/s ; $1 } readdir $d;
 214                 } else {
 215                     @files = readdir $d;
 216                 }
 217                 closedir $d;
 218             }
 219             else {
 220                 carp "Can't read $root: $!";
 221                 @files = ();
 222             }
 223
 224             # Deleting large numbers of files from VMS Files-11 filesystems
 225             # is faster if done in reverse ASCIIbetical order
 226             @files = reverse @files if $Is_VMS;
 227             ($root = VMS::Filespec::unixify($root)) =~ s#\.dir\z## if $Is_VMS;
 228             if ($Is_MacOS) {
 229                 @files = map("$root$_", @files);
 230             } else {
 231                 @files = map("$root/$_", grep $_!~/^\.{1,2}\z/s,@files);
 232             }
 233             $count += rmtree(\@files,$verbose,$safe);
 234             if ($safe &&
 235                 ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
 236                 print "skipped $root\n" if $verbose;
 237                 next;
 238             }
 239             chmod $rp | 0700, $root
 240               or carp "Can't make directory $root writeable: $!"
 241                 if $force_writeable;
 242             print "rmdir $root\n" if $verbose;
 243             if (rmdir $root) {
 244                 ++$count;
 245             }
 246             else {
 247                 carp "Can't remove directory $root: $!";
 248                 chmod($rp, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
 249                     or carp("and can't restore permissions to "
 250                             . sprintf("0%o",$rp) . "\n");
 251             }
 252         }
 253         else {
 254             if ($safe &&
 255                 ($Is_VMS ? !&VMS::Filespec::candelete($root)
 256                          : !(-l $root || -w $root)))
 257             {
 258                 print "skipped $root\n" if $verbose;
 259                 next;
 260             }
 261             chmod $rp | 0600, $root
 262               or carp "Can't make file $root writeable: $!"
 263                 if $force_writeable;
 264             print "unlink $root\n" if $verbose;
 265             # delete all versions under VMS
 266             for (;;) {
 267                 unless (unlink $root) {
 268                     carp "Can't unlink file $root: $!";
 269                     if ($force_writeable) {
 270                         chmod $rp, $root
 271                             or carp("and can't restore permissions to "
 272                                     . sprintf("0%o",$rp) . "\n");
 273                     }
 274                     last;
 275                 }
 276                 ++$count;
 277                 last unless $Is_VMS && lstat $root;
 278             }
 279         }
 280     }
 281
 282     $count;
 283 }
 284
 285 1;