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)
  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:> If the third parameter is not TRUE, C<rmtree> is B<unsecure>
  88 in the face of failure or interruption.  Files and directories which
  89 were not deleted may be left with permissions reset to allow world
  90 read and write access.  Note also that the occurrence of errors in
  91 rmtree can be determined I<only> by trapping diagnostic messages
  92 using C<$SIG{__WARN__}>; it is not apparent from the return value.
  93 Therefore, you must be extremely careful about using C<rmtree($foo,$bar,0)>
  94 in situations where security is an issue.
  95
  96 =head1 DIAGNOSTICS
  97
  98 =over 4
  99
 100 =item *
 101
 102 On Windows, if C<mkpath> gives you the warning: B<No such file or
 103 directory>, this may mean that you've exceeded your filesystem's
 104 maximum path length.
 105
 106 =back
 107
 108 =head1 AUTHORS
 109
 110 Tim Bunce <F<Tim.Bunce@ig.co.uk>> and
 111 Charles Bailey <F<bailey@newman.upenn.edu>>
 112
 113 =cut
 114
 115 use 5.006;
 116 use Carp;
 117 use File::Basename ();
 118 use Exporter ();
 119 use strict;
 120 use warnings;
 121
 122 our $VERSION = "1.06";
 123 our @ISA = qw( Exporter );
 124 our @EXPORT = qw( mkpath rmtree );
 125
 126 my $Is_VMS = $^O eq 'VMS';
 127 my $Is_MacOS = $^O eq 'MacOS';
 128
 129 # These OSes complain if you want to remove a file that you have no
 130 # write permission to:
 131 my $force_writeable = ($^O eq 'os2' || $^O eq 'dos' || $^O eq 'MSWin32' ||
 132                        $^O eq 'amigaos' || $^O eq 'MacOS' || $^O eq 'epoc');
 133
 134 sub mkpath {
 135     my($paths, $verbose, $mode) = @_;
 136     # $paths   -- either a path string or ref to list of paths
 137     # $verbose -- optional print "mkdir $path" for each directory created
 138     # $mode    -- optional permissions, defaults to 0777
 139     local($")=$Is_MacOS ? ":" : "/";
 140     $mode = 0777 unless defined($mode);
 141     $paths = [$paths] unless ref $paths;
 142     my(@created,$path);
 143     foreach $path (@$paths) {
 144         $path .= '/' if $^O eq 'os2' and $path =~ /^\w:\z/s; # feature of CRT
 145         # Logic wants Unix paths, so go with the flow.
 146         if ($Is_VMS) {
 147             next if $path eq '/';
 148             $path = VMS::Filespec::unixify($path);
 149             if ($path =~ m:^(/[^/]+)/?\z:) {
 150                 $path = $1.'/000000';
 151             }
 152         }
 153         next if -d $path;
 154         my $parent = File::Basename::dirname($path);
 155         unless (-d $parent or $path eq $parent) {
 156             push(@created,mkpath($parent, $verbose, $mode));
 157         }
 158         print "mkdir $path\n" if $verbose;
 159         unless (mkdir($path,$mode)) {
 160             my $e = $!;
 161             # allow for another process to have created it meanwhile
 162             croak "mkdir $path: $e" unless -d $path;
 163         }
 164         push(@created, $path);
 165     }
 166     @created;
 167 }
 168
 169 sub rmtree {
 170     my($roots, $verbose, $safe) = @_;
 171     my(@files);
 172     my($count) = 0;
 173     $verbose ||= 0;
 174     $safe ||= 0;
 175
 176     if ( defined($roots) && length($roots) ) {
 177       $roots = [$roots] unless ref $roots;
 178     }
 179     else {
 180       carp "No root path(s) specified\n";
 181       return 0;
 182     }
 183
 184     my($root);
 185     foreach $root (@{$roots}) {
 186         if ($Is_MacOS) {
 187             $root = ":$root" if $root !~ /:/;
 188             $root =~ s#([^:])\z#$1:#;
 189         } else {
 190             $root =~ s#/\z##;
 191         }
 192         (undef, undef, my $rp) = lstat $root or next;
 193         $rp &= 07777;   # don't forget setuid, setgid, sticky bits
 194         if ( -d _ ) {
 195             # notabene: 0777 is for making readable in the first place,
 196             # it's also intended to change it to writable in case we have
 197             # to recurse in which case we are better than rm -rf for
 198             # subtrees with strange permissions
 199             chmod(0777, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
 200               or carp "Can't make directory $root read+writeable: $!"
 201                 unless $safe;
 202
 203             if (opendir my $d, $root) {
 204                 no strict 'refs';
 205                 if (!defined ${"\cTAINT"} or ${"\cTAINT"}) {
 206                     # Blindly untaint dir names
 207                     @files = map { /^(.*)$/s ; $1 } readdir $d;
 208                 } else {
 209                     @files = readdir $d;
 210                 }
 211                 closedir $d;
 212             }
 213             else {
 214                 carp "Can't read $root: $!";
 215                 @files = ();
 216             }
 217
 218             # Deleting large numbers of files from VMS Files-11 filesystems
 219             # is faster if done in reverse ASCIIbetical order
 220             @files = reverse @files if $Is_VMS;
 221             ($root = VMS::Filespec::unixify($root)) =~ s#\.dir\z## if $Is_VMS;
 222             if ($Is_MacOS) {
 223                 @files = map("$root$_", @files);
 224             } else {
 225                 @files = map("$root/$_", grep $_!~/^\.{1,2}\z/s,@files);
 226             }
 227             $count += rmtree(\@files,$verbose,$safe);
 228             if ($safe &&
 229                 ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
 230                 print "skipped $root\n" if $verbose;
 231                 next;
 232             }
 233             chmod 0777, $root
 234               or carp "Can't make directory $root writeable: $!"
 235                 if $force_writeable;
 236             print "rmdir $root\n" if $verbose;
 237             if (rmdir $root) {
 238                 ++$count;
 239             }
 240             else {
 241                 carp "Can't remove directory $root: $!";
 242                 chmod($rp, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
 243                     or carp("and can't restore permissions to "
 244                             . sprintf("0%o",$rp) . "\n");
 245             }
 246         }
 247         else {
 248             if ($safe &&
 249                 ($Is_VMS ? !&VMS::Filespec::candelete($root)
 250                          : !(-l $root || -w $root)))
 251             {
 252                 print "skipped $root\n" if $verbose;
 253                 next;
 254             }
 255             chmod 0666, $root
 256               or carp "Can't make file $root writeable: $!"
 257                 if $force_writeable;
 258             print "unlink $root\n" if $verbose;
 259             # delete all versions under VMS
 260             for (;;) {
 261                 unless (unlink $root) {
 262                     carp "Can't unlink file $root: $!";
 263                     if ($force_writeable) {
 264                         chmod $rp, $root
 265                             or carp("and can't restore permissions to "
 266                                     . sprintf("0%o",$rp) . "\n");
 267                     }
 268                     last;
 269                 }
 270                 ++$count;
 271                 last unless $Is_VMS && lstat $root;
 272             }
 273         }
 274     }
 275
 276     $count;
 277 }
 278
 279 1;