This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate with Sarathy.
[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
a5f75d66 76treated as ordinary files.
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
ff21075d
GS
100our $VERSION = "1.0403";
101our @ISA = qw( Exporter );
102our @EXPORT = qw( mkpath rmtree );
fed7345c 103
68dc0745 104my $Is_VMS = $^O eq 'VMS';
037c8c09
CS
105
106# These OSes complain if you want to remove a file that you have no
107# write permission to:
39e571d4 108my $force_writeable = ($^O eq 'os2' || $^O eq 'dos' || $^O eq 'MSWin32'
68dc0745 109 || $^O eq 'amigaos');
748a9306 110
a5f75d66 111sub mkpath {
fed7345c
AD
112 my($paths, $verbose, $mode) = @_;
113 # $paths -- either a path string or ref to list of paths
114 # $verbose -- optional print "mkdir $path" for each directory created
115 # $mode -- optional permissions, defaults to 0777
116 local($")="/";
117 $mode = 0777 unless defined($mode);
118 $paths = [$paths] unless ref $paths;
037c8c09 119 my(@created,$path);
68dc0745 120 foreach $path (@$paths) {
1b1e14d3 121 $path .= '/' if $^O eq 'os2' and $path =~ /^\w:\z/s; # feature of CRT
037c8c09
CS
122 next if -d $path;
123 # Logic wants Unix paths, so go with the flow.
124 $path = VMS::Filespec::unixify($path) if $Is_VMS;
125 my $parent = File::Basename::dirname($path);
491527d0
GS
126 # Allow for creation of new logical filesystems under VMS
127 if (not $Is_VMS or $parent !~ m:/[^/]+/000000/?:) {
c3420933
GS
128 unless (-d $parent or $path eq $parent) {
129 push(@created,mkpath($parent, $verbose, $mode));
130 }
491527d0 131 }
037c8c09 132 print "mkdir $path\n" if $verbose;
67e4c828 133 unless (mkdir($path,$mode)) {
c3420933
GS
134 my $e = $!;
135 # allow for another process to have created it meanwhile
136 croak "mkdir $path: $e" unless -d $path;
67e4c828 137 }
037c8c09 138 push(@created, $path);
fed7345c
AD
139 }
140 @created;
141}
142
143sub rmtree {
144 my($roots, $verbose, $safe) = @_;
7301ec2d
DR
145 my(@files);
146 my($count) = 0;
037c8c09
CS
147 $verbose ||= 0;
148 $safe ||= 0;
fed7345c 149
ee79a11f
PM
150 if ( defined($roots) && length($roots) ) {
151 $roots = [$roots] unless ref $roots;
152 }
153 else {
154 carp "No root path(s) specified\n";
155 return 0;
156 }
157
037c8c09 158 my($root);
fed7345c 159 foreach $root (@{$roots}) {
1b1e14d3 160 $root =~ s#/\z##;
7025f710
CS
161 (undef, undef, my $rp) = lstat $root or next;
162 $rp &= 07777; # don't forget setuid, setgid, sticky bits
163 if ( -d _ ) {
037c8c09
CS
164 # notabene: 0777 is for making readable in the first place,
165 # it's also intended to change it to writable in case we have
166 # to recurse in which case we are better than rm -rf for
167 # subtrees with strange permissions
96e4d5b1 168 chmod(0777, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
037c8c09
CS
169 or carp "Can't make directory $root read+writeable: $!"
170 unless $safe;
171
ff21075d
GS
172 if (opendir my $d, $root) {
173 @files = readdir $d;
174 closedir $d;
175 }
176 else {
177 carp "Can't read $root: $!";
178 @files = ();
179 }
037c8c09
CS
180
181 # Deleting large numbers of files from VMS Files-11 filesystems
182 # is faster if done in reverse ASCIIbetical order
183 @files = reverse @files if $Is_VMS;
1b1e14d3
GS
184 ($root = VMS::Filespec::unixify($root)) =~ s#\.dir\z## if $Is_VMS;
185 @files = map("$root/$_", grep $_!~/^\.{1,2}\z/s,@files);
037c8c09
CS
186 $count += rmtree(\@files,$verbose,$safe);
187 if ($safe &&
188 ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
189 print "skipped $root\n" if $verbose;
190 next;
191 }
192 chmod 0777, $root
193 or carp "Can't make directory $root writeable: $!"
194 if $force_writeable;
195 print "rmdir $root\n" if $verbose;
96e4d5b1
PP
196 if (rmdir $root) {
197 ++$count;
198 }
199 else {
200 carp "Can't remove directory $root: $!";
201 chmod($rp, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
202 or carp("and can't restore permissions to "
203 . sprintf("0%o",$rp) . "\n");
204 }
037c8c09
CS
205 }
206 else {
207 if ($safe &&
64f6ddac
GS
208 ($Is_VMS ? !&VMS::Filespec::candelete($root)
209 : !(-l $root || -w $root)))
210 {
037c8c09
CS
211 print "skipped $root\n" if $verbose;
212 next;
213 }
214 chmod 0666, $root
215 or carp "Can't make file $root writeable: $!"
216 if $force_writeable;
217 print "unlink $root\n" if $verbose;
218 # delete all versions under VMS
94d4f21c
CS
219 for (;;) {
220 unless (unlink $root) {
96e4d5b1
PP
221 carp "Can't unlink file $root: $!";
222 if ($force_writeable) {
223 chmod $rp, $root
224 or carp("and can't restore permissions to "
225 . sprintf("0%o",$rp) . "\n");
226 }
94d4f21c 227 last;
96e4d5b1 228 }
94d4f21c
CS
229 ++$count;
230 last unless $Is_VMS && lstat $root;
037c8c09
CS
231 }
232 }
fed7345c
AD
233 }
234
235 $count;
236}
237
2381;