fix diagnostics to report "our" vs "my" correctly
[p5sagit/p5-mst-13.2.git] / lib / File / Path.pm
CommitLineData
1fc4cb55 1package File::Path;
fed7345c 2
3=head1 NAME
4
8b87c192 5File::Path - create or remove directory trees
fed7345c 6
7=head1 SYNOPSIS
8
8b87c192 9 use File::Path;
fed7345c 10
8b87c192 11 mkpath(['/foo/bar/baz', 'blurfl/quux'], 1, 0711);
12 rmtree(['foo/bar/baz', 'blurfl/quux'], 1, 1);
fed7345c 13
14=head1 DESCRIPTION
15
037c8c09 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 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 40It returns a list of all directories (including intermediates, determined
41using the Unix '/' separator) created.
fed7345c 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 55
56=item *
57
58a boolean value, which if TRUE will cause C<rmtree> to
748a9306 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 62(defaults to FALSE)
63
64=item *
65
66a boolean value, which if TRUE will cause C<rmtree> to
748a9306 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 72
73=back
74
96e4d5b1 75It returns the number of files successfully deleted. Symlinks are
a5f75d66 76treated as ordinary files.
fed7345c 77
96e4d5b1 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 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 92=cut
93
fed7345c 94use Carp;
037c8c09 95use File::Basename ();
96use DirHandle ();
97use Exporter ();
98use strict;
68dc0745 99
100use vars qw( $VERSION @ISA @EXPORT );
53667d02 101$VERSION = "1.0402";
fed7345c 102@ISA = qw( Exporter );
103@EXPORT = qw( mkpath rmtree );
104
68dc0745 105my $Is_VMS = $^O eq 'VMS';
037c8c09 106
107# These OSes complain if you want to remove a file that you have no
108# write permission to:
39e571d4 109my $force_writeable = ($^O eq 'os2' || $^O eq 'dos' || $^O eq 'MSWin32'
68dc0745 110 || $^O eq 'amigaos');
748a9306 111
a5f75d66 112sub mkpath {
fed7345c 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
117 local($")="/";
118 $mode = 0777 unless defined($mode);
119 $paths = [$paths] unless ref $paths;
037c8c09 120 my(@created,$path);
68dc0745 121 foreach $path (@$paths) {
491527d0 122 $path .= '/' if $^O eq 'os2' and $path =~ /^\w:$/; # feature of CRT
037c8c09 123 next if -d $path;
124 # Logic wants Unix paths, so go with the flow.
125 $path = VMS::Filespec::unixify($path) if $Is_VMS;
126 my $parent = File::Basename::dirname($path);
491527d0 127 # Allow for creation of new logical filesystems under VMS
128 if (not $Is_VMS or $parent !~ m:/[^/]+/000000/?:) {
c3420933 129 unless (-d $parent or $path eq $parent) {
130 push(@created,mkpath($parent, $verbose, $mode));
131 }
491527d0 132 }
037c8c09 133 print "mkdir $path\n" if $verbose;
67e4c828 134 unless (mkdir($path,$mode)) {
c3420933 135 my $e = $!;
136 # allow for another process to have created it meanwhile
137 croak "mkdir $path: $e" unless -d $path;
67e4c828 138 }
037c8c09 139 push(@created, $path);
fed7345c 140 }
141 @created;
142}
143
144sub rmtree {
145 my($roots, $verbose, $safe) = @_;
7301ec2d 146 my(@files);
147 my($count) = 0;
037c8c09 148 $verbose ||= 0;
149 $safe ||= 0;
fed7345c 150
ee79a11f 151 if ( defined($roots) && length($roots) ) {
152 $roots = [$roots] unless ref $roots;
153 }
154 else {
155 carp "No root path(s) specified\n";
156 return 0;
157 }
158
037c8c09 159 my($root);
fed7345c 160 foreach $root (@{$roots}) {
037c8c09 161 $root =~ s#/$##;
7025f710 162 (undef, undef, my $rp) = lstat $root or next;
163 $rp &= 07777; # don't forget setuid, setgid, sticky bits
164 if ( -d _ ) {
037c8c09 165 # notabene: 0777 is for making readable in the first place,
166 # it's also intended to change it to writable in case we have
167 # to recurse in which case we are better than rm -rf for
168 # subtrees with strange permissions
96e4d5b1 169 chmod(0777, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
037c8c09 170 or carp "Can't make directory $root read+writeable: $!"
171 unless $safe;
172
173 my $d = DirHandle->new($root)
174 or carp "Can't read $root: $!";
175 @files = $d->read;
176 $d->close;
177
178 # Deleting large numbers of files from VMS Files-11 filesystems
179 # is faster if done in reverse ASCIIbetical order
180 @files = reverse @files if $Is_VMS;
181 ($root = VMS::Filespec::unixify($root)) =~ s#\.dir$## if $Is_VMS;
182 @files = map("$root/$_", grep $_!~/^\.{1,2}$/,@files);
183 $count += rmtree(\@files,$verbose,$safe);
184 if ($safe &&
185 ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
186 print "skipped $root\n" if $verbose;
187 next;
188 }
189 chmod 0777, $root
190 or carp "Can't make directory $root writeable: $!"
191 if $force_writeable;
192 print "rmdir $root\n" if $verbose;
96e4d5b1 193 if (rmdir $root) {
194 ++$count;
195 }
196 else {
197 carp "Can't remove directory $root: $!";
198 chmod($rp, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
199 or carp("and can't restore permissions to "
200 . sprintf("0%o",$rp) . "\n");
201 }
037c8c09 202 }
203 else {
204 if ($safe &&
205 ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
206 print "skipped $root\n" if $verbose;
207 next;
208 }
209 chmod 0666, $root
210 or carp "Can't make file $root writeable: $!"
211 if $force_writeable;
212 print "unlink $root\n" if $verbose;
213 # delete all versions under VMS
94d4f21c 214 for (;;) {
215 unless (unlink $root) {
96e4d5b1 216 carp "Can't unlink file $root: $!";
217 if ($force_writeable) {
218 chmod $rp, $root
219 or carp("and can't restore permissions to "
220 . sprintf("0%o",$rp) . "\n");
221 }
94d4f21c 222 last;
96e4d5b1 223 }
94d4f21c 224 ++$count;
225 last unless $Is_VMS && lstat $root;
037c8c09 226 }
227 }
fed7345c 228 }
229
230 $count;
231}
232
2331;