xref: /onnv-gate/usr/src/cmd/perl/5.8.4/distrib/lib/File/Path.pm (revision 0:68f95e015346)
1*0Sstevel@tonic-gatepackage File::Path;
2*0Sstevel@tonic-gate
3*0Sstevel@tonic-gate=head1 NAME
4*0Sstevel@tonic-gate
5*0Sstevel@tonic-gateFile::Path - create or remove directory trees
6*0Sstevel@tonic-gate
7*0Sstevel@tonic-gate=head1 SYNOPSIS
8*0Sstevel@tonic-gate
9*0Sstevel@tonic-gate    use File::Path;
10*0Sstevel@tonic-gate
11*0Sstevel@tonic-gate    mkpath(['/foo/bar/baz', 'blurfl/quux'], 1, 0711);
12*0Sstevel@tonic-gate    rmtree(['foo/bar/baz', 'blurfl/quux'], 1, 1);
13*0Sstevel@tonic-gate
14*0Sstevel@tonic-gate=head1 DESCRIPTION
15*0Sstevel@tonic-gate
16*0Sstevel@tonic-gateThe C<mkpath> function provides a convenient way to create directories, even
17*0Sstevel@tonic-gateif your C<mkdir> kernel call won't create more than one level of directory at
18*0Sstevel@tonic-gatea time.  C<mkpath> takes three arguments:
19*0Sstevel@tonic-gate
20*0Sstevel@tonic-gate=over 4
21*0Sstevel@tonic-gate
22*0Sstevel@tonic-gate=item *
23*0Sstevel@tonic-gate
24*0Sstevel@tonic-gatethe name of the path to create, or a reference
25*0Sstevel@tonic-gateto a list of paths to create,
26*0Sstevel@tonic-gate
27*0Sstevel@tonic-gate=item *
28*0Sstevel@tonic-gate
29*0Sstevel@tonic-gatea boolean value, which if TRUE will cause C<mkpath>
30*0Sstevel@tonic-gateto print the name of each directory as it is created
31*0Sstevel@tonic-gate(defaults to FALSE), and
32*0Sstevel@tonic-gate
33*0Sstevel@tonic-gate=item *
34*0Sstevel@tonic-gate
35*0Sstevel@tonic-gatethe numeric mode to use when creating the directories
36*0Sstevel@tonic-gate(defaults to 0777)
37*0Sstevel@tonic-gate
38*0Sstevel@tonic-gate=back
39*0Sstevel@tonic-gate
40*0Sstevel@tonic-gateIt returns a list of all directories (including intermediates, determined
41*0Sstevel@tonic-gateusing the Unix '/' separator) created.
42*0Sstevel@tonic-gate
43*0Sstevel@tonic-gateIf a system error prevents a directory from being created, then the
44*0Sstevel@tonic-gateC<mkpath> function throws a fatal error with C<Carp::croak>. This error
45*0Sstevel@tonic-gatecan be trapped with an C<eval> block:
46*0Sstevel@tonic-gate
47*0Sstevel@tonic-gate  eval { mkpath($dir) };
48*0Sstevel@tonic-gate  if ($@) {
49*0Sstevel@tonic-gate    print "Couldn't create $dir: $@";
50*0Sstevel@tonic-gate  }
51*0Sstevel@tonic-gate
52*0Sstevel@tonic-gateSimilarly, the C<rmtree> function provides a convenient way to delete a
53*0Sstevel@tonic-gatesubtree from the directory structure, much like the Unix command C<rm -r>.
54*0Sstevel@tonic-gateC<rmtree> takes three arguments:
55*0Sstevel@tonic-gate
56*0Sstevel@tonic-gate=over 4
57*0Sstevel@tonic-gate
58*0Sstevel@tonic-gate=item *
59*0Sstevel@tonic-gate
60*0Sstevel@tonic-gatethe root of the subtree to delete, or a reference to
61*0Sstevel@tonic-gatea list of roots.  All of the files and directories
62*0Sstevel@tonic-gatebelow each root, as well as the roots themselves,
63*0Sstevel@tonic-gatewill be deleted.
64*0Sstevel@tonic-gate
65*0Sstevel@tonic-gate=item *
66*0Sstevel@tonic-gate
67*0Sstevel@tonic-gatea boolean value, which if TRUE will cause C<rmtree> to
68*0Sstevel@tonic-gateprint a message each time it examines a file, giving the
69*0Sstevel@tonic-gatename of the file, and indicating whether it's using C<rmdir>
70*0Sstevel@tonic-gateor C<unlink> to remove it, or that it's skipping it.
71*0Sstevel@tonic-gate(defaults to FALSE)
72*0Sstevel@tonic-gate
73*0Sstevel@tonic-gate=item *
74*0Sstevel@tonic-gate
75*0Sstevel@tonic-gatea boolean value, which if TRUE will cause C<rmtree> to
76*0Sstevel@tonic-gateskip any files to which you do not have delete access
77*0Sstevel@tonic-gate(if running under VMS) or write access (if running
78*0Sstevel@tonic-gateunder another OS).  This will change in the future when
79*0Sstevel@tonic-gatea criterion for 'delete permission' under OSs other
80*0Sstevel@tonic-gatethan VMS is settled.  (defaults to FALSE)
81*0Sstevel@tonic-gate
82*0Sstevel@tonic-gate=back
83*0Sstevel@tonic-gate
84*0Sstevel@tonic-gateIt returns the number of files successfully deleted.  Symlinks are
85*0Sstevel@tonic-gatesimply deleted and not followed.
86*0Sstevel@tonic-gate
87*0Sstevel@tonic-gateB<NOTE:> If the third parameter is not TRUE, C<rmtree> is B<unsecure>
88*0Sstevel@tonic-gatein the face of failure or interruption.  Files and directories which
89*0Sstevel@tonic-gatewere not deleted may be left with permissions reset to allow world
90*0Sstevel@tonic-gateread and write access.  Note also that the occurrence of errors in
91*0Sstevel@tonic-gatermtree can be determined I<only> by trapping diagnostic messages
92*0Sstevel@tonic-gateusing C<$SIG{__WARN__}>; it is not apparent from the return value.
93*0Sstevel@tonic-gateTherefore, you must be extremely careful about using C<rmtree($foo,$bar,0)>
94*0Sstevel@tonic-gatein situations where security is an issue.
95*0Sstevel@tonic-gate
96*0Sstevel@tonic-gate=head1 DIAGNOSTICS
97*0Sstevel@tonic-gate
98*0Sstevel@tonic-gate=over 4
99*0Sstevel@tonic-gate
100*0Sstevel@tonic-gate=item *
101*0Sstevel@tonic-gate
102*0Sstevel@tonic-gateOn Windows, if C<mkpath> gives you the warning: B<No such file or
103*0Sstevel@tonic-gatedirectory>, this may mean that you've exceeded your filesystem's
104*0Sstevel@tonic-gatemaximum path length.
105*0Sstevel@tonic-gate
106*0Sstevel@tonic-gate=back
107*0Sstevel@tonic-gate
108*0Sstevel@tonic-gate=head1 AUTHORS
109*0Sstevel@tonic-gate
110*0Sstevel@tonic-gateTim Bunce <F<Tim.Bunce@ig.co.uk>> and
111*0Sstevel@tonic-gateCharles Bailey <F<bailey@newman.upenn.edu>>
112*0Sstevel@tonic-gate
113*0Sstevel@tonic-gate=cut
114*0Sstevel@tonic-gate
115*0Sstevel@tonic-gateuse 5.006;
116*0Sstevel@tonic-gateuse Carp;
117*0Sstevel@tonic-gateuse File::Basename ();
118*0Sstevel@tonic-gateuse Exporter ();
119*0Sstevel@tonic-gateuse strict;
120*0Sstevel@tonic-gateuse warnings;
121*0Sstevel@tonic-gate
122*0Sstevel@tonic-gateour $VERSION = "1.06";
123*0Sstevel@tonic-gateour @ISA = qw( Exporter );
124*0Sstevel@tonic-gateour @EXPORT = qw( mkpath rmtree );
125*0Sstevel@tonic-gate
126*0Sstevel@tonic-gatemy $Is_VMS = $^O eq 'VMS';
127*0Sstevel@tonic-gatemy $Is_MacOS = $^O eq 'MacOS';
128*0Sstevel@tonic-gate
129*0Sstevel@tonic-gate# These OSes complain if you want to remove a file that you have no
130*0Sstevel@tonic-gate# write permission to:
131*0Sstevel@tonic-gatemy $force_writeable = ($^O eq 'os2' || $^O eq 'dos' || $^O eq 'MSWin32' ||
132*0Sstevel@tonic-gate		       $^O eq 'amigaos' || $^O eq 'MacOS' || $^O eq 'epoc');
133*0Sstevel@tonic-gate
134*0Sstevel@tonic-gatesub mkpath {
135*0Sstevel@tonic-gate    my($paths, $verbose, $mode) = @_;
136*0Sstevel@tonic-gate    # $paths   -- either a path string or ref to list of paths
137*0Sstevel@tonic-gate    # $verbose -- optional print "mkdir $path" for each directory created
138*0Sstevel@tonic-gate    # $mode    -- optional permissions, defaults to 0777
139*0Sstevel@tonic-gate    local($")=$Is_MacOS ? ":" : "/";
140*0Sstevel@tonic-gate    $mode = 0777 unless defined($mode);
141*0Sstevel@tonic-gate    $paths = [$paths] unless ref $paths;
142*0Sstevel@tonic-gate    my(@created,$path);
143*0Sstevel@tonic-gate    foreach $path (@$paths) {
144*0Sstevel@tonic-gate	$path .= '/' if $^O eq 'os2' and $path =~ /^\w:\z/s; # feature of CRT
145*0Sstevel@tonic-gate	# Logic wants Unix paths, so go with the flow.
146*0Sstevel@tonic-gate	if ($Is_VMS) {
147*0Sstevel@tonic-gate	    next if $path eq '/';
148*0Sstevel@tonic-gate	    $path = VMS::Filespec::unixify($path);
149*0Sstevel@tonic-gate	    if ($path =~ m:^(/[^/]+)/?\z:) {
150*0Sstevel@tonic-gate	        $path = $1.'/000000';
151*0Sstevel@tonic-gate	    }
152*0Sstevel@tonic-gate	}
153*0Sstevel@tonic-gate	next if -d $path;
154*0Sstevel@tonic-gate	my $parent = File::Basename::dirname($path);
155*0Sstevel@tonic-gate	unless (-d $parent or $path eq $parent) {
156*0Sstevel@tonic-gate	    push(@created,mkpath($parent, $verbose, $mode));
157*0Sstevel@tonic-gate 	}
158*0Sstevel@tonic-gate	print "mkdir $path\n" if $verbose;
159*0Sstevel@tonic-gate	unless (mkdir($path,$mode)) {
160*0Sstevel@tonic-gate	    my $e = $!;
161*0Sstevel@tonic-gate	    # allow for another process to have created it meanwhile
162*0Sstevel@tonic-gate	    croak "mkdir $path: $e" unless -d $path;
163*0Sstevel@tonic-gate	}
164*0Sstevel@tonic-gate	push(@created, $path);
165*0Sstevel@tonic-gate    }
166*0Sstevel@tonic-gate    @created;
167*0Sstevel@tonic-gate}
168*0Sstevel@tonic-gate
169*0Sstevel@tonic-gatesub rmtree {
170*0Sstevel@tonic-gate    my($roots, $verbose, $safe) = @_;
171*0Sstevel@tonic-gate    my(@files);
172*0Sstevel@tonic-gate    my($count) = 0;
173*0Sstevel@tonic-gate    $verbose ||= 0;
174*0Sstevel@tonic-gate    $safe ||= 0;
175*0Sstevel@tonic-gate
176*0Sstevel@tonic-gate    if ( defined($roots) && length($roots) ) {
177*0Sstevel@tonic-gate      $roots = [$roots] unless ref $roots;
178*0Sstevel@tonic-gate    }
179*0Sstevel@tonic-gate    else {
180*0Sstevel@tonic-gate      carp "No root path(s) specified\n";
181*0Sstevel@tonic-gate      return 0;
182*0Sstevel@tonic-gate    }
183*0Sstevel@tonic-gate
184*0Sstevel@tonic-gate    my($root);
185*0Sstevel@tonic-gate    foreach $root (@{$roots}) {
186*0Sstevel@tonic-gate    	if ($Is_MacOS) {
187*0Sstevel@tonic-gate	    $root = ":$root" if $root !~ /:/;
188*0Sstevel@tonic-gate	    $root =~ s#([^:])\z#$1:#;
189*0Sstevel@tonic-gate	} else {
190*0Sstevel@tonic-gate	    $root =~ s#/\z##;
191*0Sstevel@tonic-gate	}
192*0Sstevel@tonic-gate	(undef, undef, my $rp) = lstat $root or next;
193*0Sstevel@tonic-gate	$rp &= 07777;	# don't forget setuid, setgid, sticky bits
194*0Sstevel@tonic-gate	if ( -d _ ) {
195*0Sstevel@tonic-gate	    # notabene: 0777 is for making readable in the first place,
196*0Sstevel@tonic-gate	    # it's also intended to change it to writable in case we have
197*0Sstevel@tonic-gate	    # to recurse in which case we are better than rm -rf for
198*0Sstevel@tonic-gate	    # subtrees with strange permissions
199*0Sstevel@tonic-gate	    chmod(0777, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
200*0Sstevel@tonic-gate	      or carp "Can't make directory $root read+writeable: $!"
201*0Sstevel@tonic-gate		unless $safe;
202*0Sstevel@tonic-gate
203*0Sstevel@tonic-gate	    if (opendir my $d, $root) {
204*0Sstevel@tonic-gate		no strict 'refs';
205*0Sstevel@tonic-gate		if (!defined ${"\cTAINT"} or ${"\cTAINT"}) {
206*0Sstevel@tonic-gate		    # Blindly untaint dir names
207*0Sstevel@tonic-gate		    @files = map { /^(.*)$/s ; $1 } readdir $d;
208*0Sstevel@tonic-gate		} else {
209*0Sstevel@tonic-gate		    @files = readdir $d;
210*0Sstevel@tonic-gate		}
211*0Sstevel@tonic-gate		closedir $d;
212*0Sstevel@tonic-gate	    }
213*0Sstevel@tonic-gate	    else {
214*0Sstevel@tonic-gate	        carp "Can't read $root: $!";
215*0Sstevel@tonic-gate		@files = ();
216*0Sstevel@tonic-gate	    }
217*0Sstevel@tonic-gate
218*0Sstevel@tonic-gate	    # Deleting large numbers of files from VMS Files-11 filesystems
219*0Sstevel@tonic-gate	    # is faster if done in reverse ASCIIbetical order
220*0Sstevel@tonic-gate	    @files = reverse @files if $Is_VMS;
221*0Sstevel@tonic-gate	    ($root = VMS::Filespec::unixify($root)) =~ s#\.dir\z## if $Is_VMS;
222*0Sstevel@tonic-gate	    if ($Is_MacOS) {
223*0Sstevel@tonic-gate		@files = map("$root$_", @files);
224*0Sstevel@tonic-gate	    } else {
225*0Sstevel@tonic-gate		@files = map("$root/$_", grep $_!~/^\.{1,2}\z/s,@files);
226*0Sstevel@tonic-gate	    }
227*0Sstevel@tonic-gate	    $count += rmtree(\@files,$verbose,$safe);
228*0Sstevel@tonic-gate	    if ($safe &&
229*0Sstevel@tonic-gate		($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
230*0Sstevel@tonic-gate		print "skipped $root\n" if $verbose;
231*0Sstevel@tonic-gate		next;
232*0Sstevel@tonic-gate	    }
233*0Sstevel@tonic-gate	    chmod 0777, $root
234*0Sstevel@tonic-gate	      or carp "Can't make directory $root writeable: $!"
235*0Sstevel@tonic-gate		if $force_writeable;
236*0Sstevel@tonic-gate	    print "rmdir $root\n" if $verbose;
237*0Sstevel@tonic-gate	    if (rmdir $root) {
238*0Sstevel@tonic-gate		++$count;
239*0Sstevel@tonic-gate	    }
240*0Sstevel@tonic-gate	    else {
241*0Sstevel@tonic-gate		carp "Can't remove directory $root: $!";
242*0Sstevel@tonic-gate		chmod($rp, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
243*0Sstevel@tonic-gate		    or carp("and can't restore permissions to "
244*0Sstevel@tonic-gate		            . sprintf("0%o",$rp) . "\n");
245*0Sstevel@tonic-gate	    }
246*0Sstevel@tonic-gate	}
247*0Sstevel@tonic-gate	else {
248*0Sstevel@tonic-gate	    if ($safe &&
249*0Sstevel@tonic-gate		($Is_VMS ? !&VMS::Filespec::candelete($root)
250*0Sstevel@tonic-gate		         : !(-l $root || -w $root)))
251*0Sstevel@tonic-gate	    {
252*0Sstevel@tonic-gate		print "skipped $root\n" if $verbose;
253*0Sstevel@tonic-gate		next;
254*0Sstevel@tonic-gate	    }
255*0Sstevel@tonic-gate	    chmod 0666, $root
256*0Sstevel@tonic-gate	      or carp "Can't make file $root writeable: $!"
257*0Sstevel@tonic-gate		if $force_writeable;
258*0Sstevel@tonic-gate	    print "unlink $root\n" if $verbose;
259*0Sstevel@tonic-gate	    # delete all versions under VMS
260*0Sstevel@tonic-gate	    for (;;) {
261*0Sstevel@tonic-gate		unless (unlink $root) {
262*0Sstevel@tonic-gate		    carp "Can't unlink file $root: $!";
263*0Sstevel@tonic-gate		    if ($force_writeable) {
264*0Sstevel@tonic-gate			chmod $rp, $root
265*0Sstevel@tonic-gate			    or carp("and can't restore permissions to "
266*0Sstevel@tonic-gate			            . sprintf("0%o",$rp) . "\n");
267*0Sstevel@tonic-gate		    }
268*0Sstevel@tonic-gate		    last;
269*0Sstevel@tonic-gate		}
270*0Sstevel@tonic-gate		++$count;
271*0Sstevel@tonic-gate		last unless $Is_VMS && lstat $root;
272*0Sstevel@tonic-gate	    }
273*0Sstevel@tonic-gate	}
274*0Sstevel@tonic-gate    }
275*0Sstevel@tonic-gate
276*0Sstevel@tonic-gate    $count;
277*0Sstevel@tonic-gate}
278*0Sstevel@tonic-gate
279*0Sstevel@tonic-gate1;
280