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