This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl@27437 fix File::Path::mkpath so that perl installs on VMS
[perl5.git] / lib / File / Path.pm
CommitLineData
1fc4cb55 1package File::Path;
fed7345c
AD
2
3=head1 NAME
4
8b87c192 5File::Path - create or remove directory trees
fed7345c
AD
6
7=head1 SYNOPSIS
8
8b87c192 9 use File::Path;
fed7345c 10
8b87c192
GS
11 mkpath(['/foo/bar/baz', 'blurfl/quux'], 1, 0711);
12 rmtree(['foo/bar/baz', 'blurfl/quux'], 1, 1);
fed7345c
AD
13
14=head1 DESCRIPTION
15
037c8c09
CS
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:
fed7345c
AD
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
e2ba98a1 36(defaults to 0777), to be modified by the current umask.
fed7345c
AD
37
38=back
39
037c8c09
CS
40It returns a list of all directories (including intermediates, determined
41using the Unix '/' separator) created.
fed7345c 42
070ed461 43If a system error prevents a directory from being created, then the
99c4c5e8
AMS
44C<mkpath> function throws a fatal error with C<Carp::croak>. This error
45can be trapped with an C<eval> block:
070ed461
CM
46
47 eval { mkpath($dir) };
48 if ($@) {
49 print "Couldn't create $dir: $@";
50 }
51
fed7345c
AD
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,
567d72c2 63will be deleted.
fed7345c
AD
64
65=item *
66
67a boolean value, which if TRUE will cause C<rmtree> to
748a9306
LW
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.
fed7345c
AD
71(defaults to FALSE)
72
73=item *
74
75a boolean value, which if TRUE will cause C<rmtree> to
748a9306
LW
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
96e4d5b1 80than VMS is settled. (defaults to FALSE)
fed7345c
AD
81
82=back
83
96e4d5b1 84It returns the number of files successfully deleted. Symlinks are
341bd822 85simply deleted and not followed.
fed7345c 86
e2ba98a1
RGS
87B<NOTE:> There are race conditions internal to the implementation of
88C<rmtree> making it unsafe to use on directory trees which may be
89altered or moved while C<rmtree> is running, and in particular on any
90directory trees with any path components or subdirectories potentially
91writable by untrusted users.
92
93Additionally, if the third parameter is not TRUE and C<rmtree> is
94interrupted, it may leave files and directories with permissions altered
95to allow deletion (and older versions of this module would even set
96files and directories to world-read/writable!)
97
98Note also that the occurrence of errors in C<rmtree> can be determined I<only>
99by trapping diagnostic messages using C<$SIG{__WARN__}>; it is not apparent
100from the return value.
96e4d5b1 101
b8d5f521
CW
102=head1 DIAGNOSTICS
103
104=over 4
105
106=item *
107
108On Windows, if C<mkpath> gives you the warning: B<No such file or
109directory>, this may mean that you've exceeded your filesystem's
110maximum path length.
111
112=back
113
fed7345c
AD
114=head1 AUTHORS
115
96e4d5b1 116Tim Bunce <F<Tim.Bunce@ig.co.uk>> and
bd3fa61c 117Charles Bailey <F<bailey@newman.upenn.edu>>
fed7345c 118
fed7345c
AD
119=cut
120
3b825e41 121use 5.006;
037c8c09 122use File::Basename ();
037c8c09
CS
123use Exporter ();
124use strict;
b395063c 125use warnings;
68dc0745 126
36beb999 127our $VERSION = "1.08";
ff21075d
GS
128our @ISA = qw( Exporter );
129our @EXPORT = qw( mkpath rmtree );
fed7345c 130
68dc0745 131my $Is_VMS = $^O eq 'VMS';
ffb9ee5f 132my $Is_MacOS = $^O eq 'MacOS';
037c8c09
CS
133
134# These OSes complain if you want to remove a file that you have no
135# write permission to:
6d697788 136my $force_writeable = ($^O eq 'os2' || $^O eq 'dos' || $^O eq 'MSWin32' ||
fa6a1c44 137 $^O eq 'amigaos' || $^O eq 'MacOS' || $^O eq 'epoc');
748a9306 138
8878f897
T
139sub carp {
140 require Carp;
141 goto &Carp::carp;
142}
143
144sub croak {
145 require Carp;
146 goto &Carp::croak;
147}
148
a5f75d66 149sub mkpath {
fed7345c
AD
150 my($paths, $verbose, $mode) = @_;
151 # $paths -- either a path string or ref to list of paths
152 # $verbose -- optional print "mkdir $path" for each directory created
153 # $mode -- optional permissions, defaults to 0777
ffb9ee5f 154 local($")=$Is_MacOS ? ":" : "/";
fed7345c
AD
155 $mode = 0777 unless defined($mode);
156 $paths = [$paths] unless ref $paths;
037c8c09 157 my(@created,$path);
68dc0745 158 foreach $path (@$paths) {
1b1e14d3 159 $path .= '/' if $^O eq 'os2' and $path =~ /^\w:\z/s; # feature of CRT
037c8c09 160 # Logic wants Unix paths, so go with the flow.
e3830a4e
CB
161 if ($Is_VMS) {
162 next if $path eq '/';
163 $path = VMS::Filespec::unixify($path);
491527d0 164 }
e3830a4e
CB
165 next if -d $path;
166 my $parent = File::Basename::dirname($path);
167 unless (-d $parent or $path eq $parent) {
168 push(@created,mkpath($parent, $verbose, $mode));
169 }
037c8c09 170 print "mkdir $path\n" if $verbose;
67e4c828 171 unless (mkdir($path,$mode)) {
c3420933
GS
172 my $e = $!;
173 # allow for another process to have created it meanwhile
36beb999 174 $! = $e, croak ("mkdir $path: $e") unless -d $path;
67e4c828 175 }
037c8c09 176 push(@created, $path);
fed7345c
AD
177 }
178 @created;
179}
180
181sub rmtree {
182 my($roots, $verbose, $safe) = @_;
7301ec2d
DR
183 my(@files);
184 my($count) = 0;
037c8c09
CS
185 $verbose ||= 0;
186 $safe ||= 0;
fed7345c 187
ee79a11f
PM
188 if ( defined($roots) && length($roots) ) {
189 $roots = [$roots] unless ref $roots;
190 }
191 else {
8878f897 192 carp ("No root path(s) specified\n");
ee79a11f
PM
193 return 0;
194 }
195
037c8c09 196 my($root);
fed7345c 197 foreach $root (@{$roots}) {
ffb9ee5f
JH
198 if ($Is_MacOS) {
199 $root = ":$root" if $root !~ /:/;
200 $root =~ s#([^:])\z#$1:#;
201 } else {
202 $root =~ s#/\z##;
203 }
7025f710
CS
204 (undef, undef, my $rp) = lstat $root or next;
205 $rp &= 07777; # don't forget setuid, setgid, sticky bits
206 if ( -d _ ) {
e2ba98a1 207 # notabene: 0700 is for making readable in the first place,
037c8c09
CS
208 # it's also intended to change it to writable in case we have
209 # to recurse in which case we are better than rm -rf for
210 # subtrees with strange permissions
e2ba98a1 211 chmod($rp | 0700, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
8878f897 212 or carp ("Can't make directory $root read+writeable: $!")
037c8c09
CS
213 unless $safe;
214
ff21075d 215 if (opendir my $d, $root) {
7068481f
RGS
216 no strict 'refs';
217 if (!defined ${"\cTAINT"} or ${"\cTAINT"}) {
218 # Blindly untaint dir names
219 @files = map { /^(.*)$/s ; $1 } readdir $d;
220 } else {
221 @files = readdir $d;
222 }
ff21075d
GS
223 closedir $d;
224 }
225 else {
8878f897 226 carp ("Can't read $root: $!");
ff21075d
GS
227 @files = ();
228 }
037c8c09
CS
229
230 # Deleting large numbers of files from VMS Files-11 filesystems
231 # is faster if done in reverse ASCIIbetical order
232 @files = reverse @files if $Is_VMS;
1b1e14d3 233 ($root = VMS::Filespec::unixify($root)) =~ s#\.dir\z## if $Is_VMS;
ffb9ee5f
JH
234 if ($Is_MacOS) {
235 @files = map("$root$_", @files);
236 } else {
237 @files = map("$root/$_", grep $_!~/^\.{1,2}\z/s,@files);
238 }
037c8c09
CS
239 $count += rmtree(\@files,$verbose,$safe);
240 if ($safe &&
241 ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
242 print "skipped $root\n" if $verbose;
243 next;
244 }
e2ba98a1 245 chmod $rp | 0700, $root
8878f897 246 or carp ("Can't make directory $root writeable: $!")
037c8c09
CS
247 if $force_writeable;
248 print "rmdir $root\n" if $verbose;
96e4d5b1
PP
249 if (rmdir $root) {
250 ++$count;
251 }
252 else {
8878f897 253 carp ("Can't remove directory $root: $!");
96e4d5b1
PP
254 chmod($rp, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
255 or carp("and can't restore permissions to "
256 . sprintf("0%o",$rp) . "\n");
257 }
037c8c09
CS
258 }
259 else {
260 if ($safe &&
64f6ddac
GS
261 ($Is_VMS ? !&VMS::Filespec::candelete($root)
262 : !(-l $root || -w $root)))
263 {
037c8c09
CS
264 print "skipped $root\n" if $verbose;
265 next;
266 }
e2ba98a1 267 chmod $rp | 0600, $root
8878f897 268 or carp ("Can't make file $root writeable: $!")
037c8c09
CS
269 if $force_writeable;
270 print "unlink $root\n" if $verbose;
271 # delete all versions under VMS
94d4f21c
CS
272 for (;;) {
273 unless (unlink $root) {
8878f897 274 carp ("Can't unlink file $root: $!");
96e4d5b1
PP
275 if ($force_writeable) {
276 chmod $rp, $root
277 or carp("and can't restore permissions to "
278 . sprintf("0%o",$rp) . "\n");
279 }
94d4f21c 280 last;
96e4d5b1 281 }
94d4f21c
CS
282 ++$count;
283 last unless $Is_VMS && lstat $root;
037c8c09
CS
284 }
285 }
fed7345c
AD
286 }
287
288 $count;
289}
290
2911;