This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate changes #9259,9260 from maintperl into mainline.
[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
36(defaults to 0777)
37
38=back
39
037c8c09
CS
40It returns a list of all directories (including intermediates, determined
41using the Unix '/' separator) created.
fed7345c
AD
42
43Similarly, the C<rmtree> function provides a convenient way to delete a
44subtree from the directory structure, much like the Unix command C<rm -r>.
45C<rmtree> takes three arguments:
46
47=over 4
48
49=item *
50
51the root of the subtree to delete, or a reference to
52a list of roots. All of the files and directories
53below each root, as well as the roots themselves,
567d72c2 54will be deleted.
fed7345c
AD
55
56=item *
57
58a boolean value, which if TRUE will cause C<rmtree> to
748a9306
LW
59print a message each time it examines a file, giving the
60name of the file, and indicating whether it's using C<rmdir>
61or C<unlink> to remove it, or that it's skipping it.
fed7345c
AD
62(defaults to FALSE)
63
64=item *
65
66a boolean value, which if TRUE will cause C<rmtree> to
748a9306
LW
67skip any files to which you do not have delete access
68(if running under VMS) or write access (if running
69under another OS). This will change in the future when
70a criterion for 'delete permission' under OSs other
96e4d5b1 71than VMS is settled. (defaults to FALSE)
fed7345c
AD
72
73=back
74
96e4d5b1 75It returns the number of files successfully deleted. Symlinks are
341bd822 76simply deleted and not followed.
fed7345c 77
96e4d5b1
PP
78B<NOTE:> If the third parameter is not TRUE, C<rmtree> is B<unsecure>
79in the face of failure or interruption. Files and directories which
80were not deleted may be left with permissions reset to allow world
81read and write access. Note also that the occurrence of errors in
82rmtree can be determined I<only> by trapping diagnostic messages
83using C<$SIG{__WARN__}>; it is not apparent from the return value.
84Therefore, you must be extremely careful about using C<rmtree($foo,$bar,0>
85in situations where security is an issue.
86
fed7345c
AD
87=head1 AUTHORS
88
96e4d5b1 89Tim Bunce <F<Tim.Bunce@ig.co.uk>> and
bd3fa61c 90Charles Bailey <F<bailey@newman.upenn.edu>>
fed7345c 91
fed7345c
AD
92=cut
93
17f410f9 94use 5.005_64;
fed7345c 95use Carp;
037c8c09 96use File::Basename ();
037c8c09
CS
97use Exporter ();
98use strict;
68dc0745 99
ffb9ee5f 100our $VERSION = "1.0404";
ff21075d
GS
101our @ISA = qw( Exporter );
102our @EXPORT = qw( mkpath rmtree );
fed7345c 103
68dc0745 104my $Is_VMS = $^O eq 'VMS';
ffb9ee5f 105my $Is_MacOS = $^O eq 'MacOS';
037c8c09
CS
106
107# These OSes complain if you want to remove a file that you have no
108# write permission to:
6d697788 109my $force_writeable = ($^O eq 'os2' || $^O eq 'dos' || $^O eq 'MSWin32' ||
fa6a1c44 110 $^O eq 'amigaos' || $^O eq 'MacOS' || $^O eq 'epoc');
748a9306 111
a5f75d66 112sub mkpath {
fed7345c
AD
113 my($paths, $verbose, $mode) = @_;
114 # $paths -- either a path string or ref to list of paths
115 # $verbose -- optional print "mkdir $path" for each directory created
116 # $mode -- optional permissions, defaults to 0777
ffb9ee5f 117 local($")=$Is_MacOS ? ":" : "/";
fed7345c
AD
118 $mode = 0777 unless defined($mode);
119 $paths = [$paths] unless ref $paths;
037c8c09 120 my(@created,$path);
68dc0745 121 foreach $path (@$paths) {
1b1e14d3 122 $path .= '/' if $^O eq 'os2' and $path =~ /^\w:\z/s; # feature of CRT
037c8c09 123 # Logic wants Unix paths, so go with the flow.
e3830a4e
CB
124 if ($Is_VMS) {
125 next if $path eq '/';
126 $path = VMS::Filespec::unixify($path);
127 if ($path =~ m:^(/[^/]+)/?\z:) {
128 $path = $1.'/000000';
c3420933 129 }
491527d0 130 }
e3830a4e
CB
131 next if -d $path;
132 my $parent = File::Basename::dirname($path);
133 unless (-d $parent or $path eq $parent) {
134 push(@created,mkpath($parent, $verbose, $mode));
135 }
037c8c09 136 print "mkdir $path\n" if $verbose;
67e4c828 137 unless (mkdir($path,$mode)) {
c3420933
GS
138 my $e = $!;
139 # allow for another process to have created it meanwhile
140 croak "mkdir $path: $e" unless -d $path;
67e4c828 141 }
037c8c09 142 push(@created, $path);
fed7345c
AD
143 }
144 @created;
145}
146
147sub rmtree {
148 my($roots, $verbose, $safe) = @_;
7301ec2d
DR
149 my(@files);
150 my($count) = 0;
037c8c09
CS
151 $verbose ||= 0;
152 $safe ||= 0;
fed7345c 153
ee79a11f
PM
154 if ( defined($roots) && length($roots) ) {
155 $roots = [$roots] unless ref $roots;
156 }
157 else {
158 carp "No root path(s) specified\n";
159 return 0;
160 }
161
037c8c09 162 my($root);
fed7345c 163 foreach $root (@{$roots}) {
ffb9ee5f
JH
164 if ($Is_MacOS) {
165 $root = ":$root" if $root !~ /:/;
166 $root =~ s#([^:])\z#$1:#;
167 } else {
168 $root =~ s#/\z##;
169 }
7025f710
CS
170 (undef, undef, my $rp) = lstat $root or next;
171 $rp &= 07777; # don't forget setuid, setgid, sticky bits
172 if ( -d _ ) {
037c8c09
CS
173 # notabene: 0777 is for making readable in the first place,
174 # it's also intended to change it to writable in case we have
175 # to recurse in which case we are better than rm -rf for
176 # subtrees with strange permissions
96e4d5b1 177 chmod(0777, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
037c8c09
CS
178 or carp "Can't make directory $root read+writeable: $!"
179 unless $safe;
180
ff21075d
GS
181 if (opendir my $d, $root) {
182 @files = readdir $d;
183 closedir $d;
184 }
185 else {
186 carp "Can't read $root: $!";
187 @files = ();
188 }
037c8c09
CS
189
190 # Deleting large numbers of files from VMS Files-11 filesystems
191 # is faster if done in reverse ASCIIbetical order
192 @files = reverse @files if $Is_VMS;
1b1e14d3 193 ($root = VMS::Filespec::unixify($root)) =~ s#\.dir\z## if $Is_VMS;
ffb9ee5f
JH
194 if ($Is_MacOS) {
195 @files = map("$root$_", @files);
196 } else {
197 @files = map("$root/$_", grep $_!~/^\.{1,2}\z/s,@files);
198 }
037c8c09
CS
199 $count += rmtree(\@files,$verbose,$safe);
200 if ($safe &&
201 ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
202 print "skipped $root\n" if $verbose;
203 next;
204 }
205 chmod 0777, $root
206 or carp "Can't make directory $root writeable: $!"
207 if $force_writeable;
208 print "rmdir $root\n" if $verbose;
96e4d5b1
PP
209 if (rmdir $root) {
210 ++$count;
211 }
212 else {
213 carp "Can't remove directory $root: $!";
214 chmod($rp, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
215 or carp("and can't restore permissions to "
216 . sprintf("0%o",$rp) . "\n");
217 }
037c8c09
CS
218 }
219 else {
220 if ($safe &&
64f6ddac
GS
221 ($Is_VMS ? !&VMS::Filespec::candelete($root)
222 : !(-l $root || -w $root)))
223 {
037c8c09
CS
224 print "skipped $root\n" if $verbose;
225 next;
226 }
227 chmod 0666, $root
228 or carp "Can't make file $root writeable: $!"
229 if $force_writeable;
230 print "unlink $root\n" if $verbose;
231 # delete all versions under VMS
94d4f21c
CS
232 for (;;) {
233 unless (unlink $root) {
96e4d5b1
PP
234 carp "Can't unlink file $root: $!";
235 if ($force_writeable) {
236 chmod $rp, $root
237 or carp("and can't restore permissions to "
238 . sprintf("0%o",$rp) . "\n");
239 }
94d4f21c 240 last;
96e4d5b1 241 }
94d4f21c
CS
242 ++$count;
243 last unless $Is_VMS && lstat $root;
037c8c09
CS
244 }
245 }
fed7345c
AD
246 }
247
248 $count;
249}
250
2511;