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.08";
 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 = $!;
 174             # allow for another process to have created it meanwhile
 175             $! = $e, croak ("mkdir $path: $e") unless -d $path;
 176         }
 177         push(@created, $path);
 178     }
 179     @created;
 180 }
 181
 182 sub rmtree {
 183     my($roots, $verbose, $safe) = @_;
 184     my(@files);
 185     my($count) = 0;
 186     $verbose ||= 0;
 187     $safe ||= 0;
 188
 189     if ( defined($roots) && length($roots) ) {
 190       $roots = [$roots] unless ref $roots;
 191     }
 192     else {
 193       carp ("No root path(s) specified\n");
 194       return 0;
 195     }
 196
 197     my($root);
 198     foreach $root (@{$roots}) {
 199         if ($Is_MacOS) {
 200             $root = ":$root" if $root !~ /:/;
 201             $root =~ s#([^:])\z#$1:#;
 202         } else {
 203             $root =~ s#/\z##;
 204         }
 205         (undef, undef, my $rp) = lstat $root or next;
 206         $rp &= 07777;   # don't forget setuid, setgid, sticky bits
 207         if ( -d _ ) {
 208             # notabene: 0700 is for making readable in the first place,
 209             # it's also intended to change it to writable in case we have
 210             # to recurse in which case we are better than rm -rf for
 211             # subtrees with strange permissions
 212             chmod($rp | 0700, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
 213               or carp ("Can't make directory $root read+writeable: $!")
 214                 unless $safe;
 215
 216             if (opendir my $d, $root) {
 217                 no strict 'refs';
 218                 if (!defined ${"\cTAINT"} or ${"\cTAINT"}) {
 219                     # Blindly untaint dir names
 220                     @files = map { /^(.*)$/s ; $1 } readdir $d;
 221                 } else {
 222                     @files = readdir $d;
 223                 }
 224                 closedir $d;
 225             }
 226             else {
 227                 carp ("Can't read $root: $!");
 228                 @files = ();
 229             }
 230
 231             # Deleting large numbers of files from VMS Files-11 filesystems
 232             # is faster if done in reverse ASCIIbetical order
 233             @files = reverse @files if $Is_VMS;
 234             ($root = VMS::Filespec::unixify($root)) =~ s#\.dir\z## if $Is_VMS;
 235             if ($Is_MacOS) {
 236                 @files = map("$root$_", @files);
 237             } else {
 238                 @files = map("$root/$_", grep $_!~/^\.{1,2}\z/s,@files);
 239             }
 240             $count += rmtree(\@files,$verbose,$safe);
 241             if ($safe &&
 242                 ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
 243                 print "skipped $root\n" if $verbose;
 244                 next;
 245             }
 246             chmod $rp | 0700, $root
 247               or carp ("Can't make directory $root writeable: $!")
 248                 if $force_writeable;
 249             print "rmdir $root\n" if $verbose;
 250             if (rmdir $root) {
 251                 ++$count;
 252             }
 253             else {
 254                 carp ("Can't remove directory $root: $!");
 255                 chmod($rp, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
 256                     or carp("and can't restore permissions to "
 257                             . sprintf("0%o",$rp) . "\n");
 258             }
 259         }
 260         else {
 261             if ($safe &&
 262                 ($Is_VMS ? !&VMS::Filespec::candelete($root)
 263                          : !(-l $root || -w $root)))
 264             {
 265                 print "skipped $root\n" if $verbose;
 266                 next;
 267             }
 268             chmod $rp | 0600, $root
 269               or carp ("Can't make file $root writeable: $!")
 270                 if $force_writeable;
 271             print "unlink $root\n" if $verbose;
 272             # delete all versions under VMS
 273             for (;;) {
 274                 unless (unlink $root) {
 275                     carp ("Can't unlink file $root: $!");
 276                     if ($force_writeable) {
 277                         chmod $rp, $root
 278                             or carp("and can't restore permissions to "
 279                                     . sprintf("0%o",$rp) . "\n");
 280                     }
 281                     last;
 282                 }
 283                 ++$count;
 284                 last unless $Is_VMS && lstat $root;
 285             }
 286         }
 287     }
 288
 289     $count;
 290 }
 291
 292 1;