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