1package File::Path; 2 3=head1 NAME 4 5File::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 16The C<mkpath> function provides a convenient way to create directories, even 17if your C<mkdir> kernel call won't create more than one level of directory at 18a time. C<mkpath> takes three arguments: 19 20=over 4 21 22=item * 23 24the name of the path to create, or a reference 25to a list of paths to create, 26 27=item * 28 29a boolean value, which if TRUE will cause C<mkpath> 30to print the name of each directory as it is created 31(defaults to FALSE), and 32 33=item * 34 35the numeric mode to use when creating the directories 36(defaults to 0777) 37 38=back 39 40It returns a list of all directories (including intermediates, determined 41using the Unix '/' separator) created. 42 43If a system error prevents a directory from being created, then the 44C<mkpath> function throws a fatal error with C<Carp::croak>. This error 45can be trapped with an C<eval> block: 46 47 eval { mkpath($dir) }; 48 if ($@) { 49 print "Couldn't create $dir: $@"; 50 } 51 52Similarly, the C<rmtree> function provides a convenient way to delete a 53subtree from the directory structure, much like the Unix command C<rm -r>. 54C<rmtree> takes three arguments: 55 56=over 4 57 58=item * 59 60the root of the subtree to delete, or a reference to 61a list of roots. All of the files and directories 62below each root, as well as the roots themselves, 63will be deleted. 64 65=item * 66 67a boolean value, which if TRUE will cause C<rmtree> to 68print a message each time it examines a file, giving the 69name of the file, and indicating whether it's using C<rmdir> 70or C<unlink> to remove it, or that it's skipping it. 71(defaults to FALSE) 72 73=item * 74 75a boolean value, which if TRUE will cause C<rmtree> to 76skip any files to which you do not have delete access 77(if running under VMS) or write access (if running 78under another OS). This will change in the future when 79a criterion for 'delete permission' under OSs other 80than VMS is settled. (defaults to FALSE) 81 82=back 83 84It returns the number of files successfully deleted. Symlinks are 85simply deleted and not followed. 86 87B<NOTE:> If the third parameter is not TRUE, C<rmtree> is B<unsecure> 88in the face of failure or interruption. Files and directories which 89were not deleted may be left with permissions reset to allow world 90read and write access. Note also that the occurrence of errors in 91rmtree can be determined I<only> by trapping diagnostic messages 92using C<$SIG{__WARN__}>; it is not apparent from the return value. 93Therefore, you must be extremely careful about using C<rmtree($foo,$bar,0)> 94in situations where security is an issue. 95 96=head1 DIAGNOSTICS 97 98=over 4 99 100=item * 101 102On Windows, if C<mkpath> gives you the warning: B<No such file or 103directory>, this may mean that you've exceeded your filesystem's 104maximum path length. 105 106=back 107 108=head1 AUTHORS 109 110Tim Bunce <F<Tim.Bunce@ig.co.uk>> and 111Charles Bailey <F<bailey@newman.upenn.edu>> 112 113=cut 114 115use 5.006; 116use Carp; 117use File::Basename (); 118use Exporter (); 119use strict; 120use warnings; 121 122our $VERSION = "1.06"; 123our @ISA = qw( Exporter ); 124our @EXPORT = qw( mkpath rmtree ); 125 126my $Is_VMS = $^O eq 'VMS'; 127my $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: 131my $force_writeable = ($^O eq 'os2' || $^O eq 'dos' || $^O eq 'MSWin32' || 132 $^O eq 'amigaos' || $^O eq 'MacOS' || $^O eq 'epoc'); 133 134sub 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 169sub 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 2791; 280