[p5sagit/p5-mst-13.2.git] / lib / File / Path.pm

package File::Path;

=head1 NAME

File::Path - create or remove directory trees

=head1 SYNOPSIS

    use File::Path;

    mkpath(['/foo/bar/baz', 'blurfl/quux'], 1, 0711);
    rmtree(['foo/bar/baz', 'blurfl/quux'], 1, 1);

=head1 DESCRIPTION

The C<mkpath> function provides a convenient way to create directories, even
if your C<mkdir> kernel call won't create more than one level of directory at
a time.  C<mkpath> takes three arguments:

=over 4

=item *

the name of the path to create, or a reference
to a list of paths to create,

=item *

a boolean value, which if TRUE will cause C<mkpath>
to print the name of each directory as it is created
(defaults to FALSE), and

=item *

the numeric mode to use when creating the directories
(defaults to 0777), to be modified by the current umask.

=back

It returns a list of all directories (including intermediates, determined
using the Unix '/' separator) created.

If a system error prevents a directory from being created, then the
C<mkpath> function throws a fatal error with C<Carp::croak>. This error
can be trapped with an C<eval> block:

  eval { mkpath($dir) };
  if ($@) {
    print "Couldn't create $dir: $@";
  }

Similarly, the C<rmtree> function provides a convenient way to delete a
subtree from the directory structure, much like the Unix command C<rm -r>.
C<rmtree> takes three arguments:

=over 4

=item *

the root of the subtree to delete, or a reference to
a list of roots.  All of the files and directories
below each root, as well as the roots themselves,
will be deleted.

=item *

a boolean value, which if TRUE will cause C<rmtree> to
print a message each time it examines a file, giving the
name of the file, and indicating whether it's using C<rmdir>
or C<unlink> to remove it, or that it's skipping it.
(defaults to FALSE)

=item *

a boolean value, which if TRUE will cause C<rmtree> to
skip any files to which you do not have delete access
(if running under VMS) or write access (if running
under another OS).  This will change in the future when
a criterion for 'delete permission' under OSs other
than VMS is settled.  (defaults to FALSE)

=back

It returns the number of files successfully deleted.  Symlinks are
simply deleted and not followed.

B<NOTE:> There are race conditions internal to the implementation of
C<rmtree> making it unsafe to use on directory trees which may be
altered or moved while C<rmtree> is running, and in particular on any
directory trees with any path components or subdirectories potentially
writable by untrusted users.

Additionally, if the third parameter is not TRUE and C<rmtree> is
interrupted, it may leave files and directories with permissions altered
to allow deletion (and older versions of this module would even set
files and directories to world-read/writable!)

Note also that the occurrence of errors in C<rmtree> can be determined I<only>
by trapping diagnostic messages using C<$SIG{__WARN__}>; it is not apparent
from the return value.

=head1 DIAGNOSTICS

=over 4

=item *

On Windows, if C<mkpath> gives you the warning: B<No such file or
directory>, this may mean that you've exceeded your filesystem's
maximum path length.

=back

=head1 AUTHORS

Tim Bunce <F<Tim.Bunce@ig.co.uk>> and
Charles Bailey <F<bailey@newman.upenn.edu>>

=cut

use 5.006;
use Carp;
use File::Basename ();
use Exporter ();
use strict;
use warnings;

our $VERSION = "1.06";
our @ISA = qw( Exporter );
our @EXPORT = qw( mkpath rmtree );

my $Is_VMS = $^O eq 'VMS';
my $Is_MacOS = $^O eq 'MacOS';

# These OSes complain if you want to remove a file that you have no
# write permission to:
my $force_writeable = ($^O eq 'os2' || $^O eq 'dos' || $^O eq 'MSWin32' ||
		       $^O eq 'amigaos' || $^O eq 'MacOS' || $^O eq 'epoc');

sub mkpath {
    my($paths, $verbose, $mode) = @_;
    # $paths   -- either a path string or ref to list of paths
    # $verbose -- optional print "mkdir $path" for each directory created
    # $mode    -- optional permissions, defaults to 0777
    local($")=$Is_MacOS ? ":" : "/";
    $mode = 0777 unless defined($mode);
    $paths = [$paths] unless ref $paths;
    my(@created,$path);
    foreach $path (@$paths) {
	$path .= '/' if $^O eq 'os2' and $path =~ /^\w:\z/s; # feature of CRT 
	# Logic wants Unix paths, so go with the flow.
	if ($Is_VMS) {
	    next if $path eq '/';
	    $path = VMS::Filespec::unixify($path);
	    if ($path =~ m:^(/[^/]+)/?\z:) {
	        $path = $1.'/000000';
	    }
	}
	next if -d $path;
	my $parent = File::Basename::dirname($path);
	unless (-d $parent or $path eq $parent) {
	    push(@created,mkpath($parent, $verbose, $mode));
 	}
	print "mkdir $path\n" if $verbose;
	unless (mkdir($path,$mode)) {
	    my $e = $!;
	    # allow for another process to have created it meanwhile
	    croak "mkdir $path: $e" unless -d $path;
	}
	push(@created, $path);
    }
    @created;
}

sub rmtree {
    my($roots, $verbose, $safe) = @_;
    my(@files);
    my($count) = 0;
    $verbose ||= 0;
    $safe ||= 0;

    if ( defined($roots) && length($roots) ) {
      $roots = [$roots] unless ref $roots;
    }
    else {
      carp "No root path(s) specified\n";
      return 0;
    }

    my($root);
    foreach $root (@{$roots}) {
    	if ($Is_MacOS) {
	    $root = ":$root" if $root !~ /:/;
	    $root =~ s#([^:])\z#$1:#;
	} else {
	    $root =~ s#/\z##;
	}
	(undef, undef, my $rp) = lstat $root or next;
	$rp &= 07777;	# don't forget setuid, setgid, sticky bits
	if ( -d _ ) {
	    # notabene: 0700 is for making readable in the first place,
	    # it's also intended to change it to writable in case we have
	    # to recurse in which case we are better than rm -rf for 
	    # subtrees with strange permissions
	    chmod($rp | 0700, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
	      or carp "Can't make directory $root read+writeable: $!"
		unless $safe;

	    if (opendir my $d, $root) {
		no strict 'refs';
		if (!defined ${"\cTAINT"} or ${"\cTAINT"}) {
		    # Blindly untaint dir names
		    @files = map { /^(.*)$/s ; $1 } readdir $d;
		} else {
		    @files = readdir $d;
		}
		closedir $d;
	    }
	    else {
	        carp "Can't read $root: $!";
		@files = ();
	    }

	    # Deleting large numbers of files from VMS Files-11 filesystems
	    # is faster if done in reverse ASCIIbetical order 
	    @files = reverse @files if $Is_VMS;
	    ($root = VMS::Filespec::unixify($root)) =~ s#\.dir\z## if $Is_VMS;
	    if ($Is_MacOS) {
		@files = map("$root$_", @files);
	    } else {
		@files = map("$root/$_", grep $_!~/^\.{1,2}\z/s,@files);
	    }
	    $count += rmtree(\@files,$verbose,$safe);
	    if ($safe &&
		($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
		print "skipped $root\n" if $verbose;
		next;
	    }
	    chmod $rp | 0700, $root
	      or carp "Can't make directory $root writeable: $!"
		if $force_writeable;
	    print "rmdir $root\n" if $verbose;
	    if (rmdir $root) {
		++$count;
	    }
	    else {
		carp "Can't remove directory $root: $!";
		chmod($rp, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
		    or carp("and can't restore permissions to "
		            . sprintf("0%o",$rp) . "\n");
	    }
	}
	else { 
	    if ($safe &&
		($Is_VMS ? !&VMS::Filespec::candelete($root)
		         : !(-l $root || -w $root)))
	    {
		print "skipped $root\n" if $verbose;
		next;
	    }
	    chmod $rp | 0600, $root
	      or carp "Can't make file $root writeable: $!"
		if $force_writeable;
	    print "unlink $root\n" if $verbose;
	    # delete all versions under VMS
	    for (;;) {
		unless (unlink $root) {
		    carp "Can't unlink file $root: $!";
		    if ($force_writeable) {
			chmod $rp, $root
			    or carp("and can't restore permissions to "
			            . sprintf("0%o",$rp) . "\n");
		    }
		    last;
		}
		++$count;
		last unless $Is_VMS && lstat $root;
	    }
	}
    }

    $count;
}

1;
Commit	Line	Data
1fc4cb55	1	package File::Path;
fed7345c	2
	3	=head1 NAME
	4
8b87c192	5	File::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);
8b87c192	12	rmtree(['foo/bar/baz', 'blurfl/quux'], 1, 1);
fed7345c	13
	14	=head1 DESCRIPTION
	15
037c8c09	16	The C<mkpath> function provides a convenient way to create directories, even
	17	if your C<mkdir> kernel call won't create more than one level of directory at
	18	a time. C<mkpath> takes three arguments:
fed7345c	19
	20	=over 4
	21
	22	=item *
	23
	24	the name of the path to create, or a reference
	25	to a list of paths to create,
	26
	27	=item *
	28
	29	a boolean value, which if TRUE will cause C<mkpath>
	30	to print the name of each directory as it is created
	31	(defaults to FALSE), and
	32
	33	=item *
	34
	35	the numeric mode to use when creating the directories
e2ba98a1	36	(defaults to 0777), to be modified by the current umask.
fed7345c	37
	38	=back
	39
037c8c09	40	It returns a list of all directories (including intermediates, determined
037c8c09	41	using the Unix '/' separator) created.
fed7345c	42
070ed461	43	If a system error prevents a directory from being created, then the
99c4c5e8	44	C<mkpath> function throws a fatal error with C<Carp::croak>. This error
99c4c5e8	45	can be trapped with an C<eval> block:
070ed461	46
	47	eval { mkpath($dir) };
	48	if ($@) {
	49	print "Couldn't create $dir: $@";
	50	}
	51
fed7345c	52	Similarly, the C<rmtree> function provides a convenient way to delete a
	53	subtree from the directory structure, much like the Unix command C<rm -r>.
	54	C<rmtree> takes three arguments:
	55
	56	=over 4
	57
	58	=item *
	59
	60	the root of the subtree to delete, or a reference to
	61	a list of roots. All of the files and directories
	62	below each root, as well as the roots themselves,
567d72c2	63	will be deleted.
fed7345c	64
	65	=item *
	66
	67	a boolean value, which if TRUE will cause C<rmtree> to
748a9306	68	print a message each time it examines a file, giving the
	69	name of the file, and indicating whether it's using C<rmdir>
	70	or C<unlink> to remove it, or that it's skipping it.
fed7345c	71	(defaults to FALSE)
	72
	73	=item *
	74
	75	a boolean value, which if TRUE will cause C<rmtree> to
748a9306	76	skip any files to which you do not have delete access
	77	(if running under VMS) or write access (if running
	78	under another OS). This will change in the future when
	79	a criterion for 'delete permission' under OSs other
96e4d5b1	80	than VMS is settled. (defaults to FALSE)
fed7345c	81
	82	=back
	83
96e4d5b1	84	It returns the number of files successfully deleted. Symlinks are
341bd822	85	simply deleted and not followed.
fed7345c	86
e2ba98a1	87	B<NOTE:> There are race conditions internal to the implementation of
	88	C<rmtree> making it unsafe to use on directory trees which may be
	89	altered or moved while C<rmtree> is running, and in particular on any
	90	directory trees with any path components or subdirectories potentially
	91	writable by untrusted users.
	92
	93	Additionally, if the third parameter is not TRUE and C<rmtree> is
	94	interrupted, it may leave files and directories with permissions altered
	95	to allow deletion (and older versions of this module would even set
	96	files and directories to world-read/writable!)
	97
	98	Note also that the occurrence of errors in C<rmtree> can be determined I<only>
	99	by trapping diagnostic messages using C<$SIG{__WARN__}>; it is not apparent
	100	from the return value.
96e4d5b1	101
b8d5f521	102	=head1 DIAGNOSTICS
	103
	104	=over 4
	105
	106	=item *
	107
	108	On Windows, if C<mkpath> gives you the warning: B<No such file or
	109	directory>, this may mean that you've exceeded your filesystem's
	110	maximum path length.
	111
	112	=back
	113
fed7345c	114	=head1 AUTHORS
fed7345c	115
96e4d5b1	116	Tim Bunce <F<Tim.Bunce@ig.co.uk>> and
bd3fa61c	117	Charles Bailey <F<bailey@newman.upenn.edu>>
fed7345c	118
fed7345c	119	=cut
fed7345c	120
3b825e41	121	use 5.006;
fed7345c	122	use Carp;
037c8c09	123	use File::Basename ();
037c8c09	124	use Exporter ();
037c8c09	125	use strict;
b395063c	126	use warnings;
68dc0745	127
2af1ab88	128	our $VERSION = "1.06";
ff21075d	129	our @ISA = qw( Exporter );
ff21075d	130	our @EXPORT = qw( mkpath rmtree );
fed7345c	131
68dc0745	132	my $Is_VMS = $^O eq 'VMS';
ffb9ee5f	133	my $Is_MacOS = $^O eq 'MacOS';
037c8c09	134
	135	# These OSes complain if you want to remove a file that you have no
	136	# write permission to:
6d697788	137	my $force_writeable = ($^O eq 'os2' \|\| $^O eq 'dos' \|\| $^O eq 'MSWin32' \|\|
fa6a1c44	138	$^O eq 'amigaos' \|\| $^O eq 'MacOS' \|\| $^O eq 'epoc');
748a9306	139
a5f75d66	140	sub mkpath {
fed7345c	141	my($paths, $verbose, $mode) = @_;
	142	# $paths -- either a path string or ref to list of paths
	143	# $verbose -- optional print "mkdir $path" for each directory created
	144	# $mode -- optional permissions, defaults to 0777
ffb9ee5f	145	local($")=$Is_MacOS ? ":" : "/";
fed7345c	146	$mode = 0777 unless defined($mode);
fed7345c	147	$paths = [$paths] unless ref $paths;
037c8c09	148	my(@created,$path);
68dc0745	149	foreach $path (@$paths) {
1b1e14d3	150	$path .= '/' if $^O eq 'os2' and $path =~ /^\w:\z/s; # feature of CRT
037c8c09	151	# Logic wants Unix paths, so go with the flow.
e3830a4e	152	if ($Is_VMS) {
	153	next if $path eq '/';
	154	$path = VMS::Filespec::unixify($path);
	155	if ($path =~ m:^(/[^/]+)/?\z:) {
	156	$path = $1.'/000000';
c3420933	157	}
491527d0	158	}
e3830a4e	159	next if -d $path;
	160	my $parent = File::Basename::dirname($path);
	161	unless (-d $parent or $path eq $parent) {
	162	push(@created,mkpath($parent, $verbose, $mode));
	163	}
037c8c09	164	print "mkdir $path\n" if $verbose;
67e4c828	165	unless (mkdir($path,$mode)) {
c3420933	166	my $e = $!;
	167	# allow for another process to have created it meanwhile
	168	croak "mkdir $path: $e" unless -d $path;
67e4c828	169	}
037c8c09	170	push(@created, $path);
fed7345c	171	}
	172	@created;
	173	}
	174
	175	sub rmtree {
	176	my($roots, $verbose, $safe) = @_;
7301ec2d	177	my(@files);
7301ec2d	178	my($count) = 0;
037c8c09	179	$verbose \|\|= 0;
037c8c09	180	$safe \|\|= 0;
fed7345c	181
ee79a11f	182	if ( defined($roots) && length($roots) ) {
	183	$roots = [$roots] unless ref $roots;
	184	}
	185	else {
	186	carp "No root path(s) specified\n";
	187	return 0;
	188	}
	189
037c8c09	190	my($root);
fed7345c	191	foreach $root (@{$roots}) {
ffb9ee5f	192	if ($Is_MacOS) {
	193	$root = ":$root" if $root !~ /:/;
	194	$root =~ s#([^:])\z#$1:#;
	195	} else {
	196	$root =~ s#/\z##;
	197	}
7025f710	198	(undef, undef, my $rp) = lstat $root or next;
	199	$rp &= 07777; # don't forget setuid, setgid, sticky bits
	200	if ( -d _ ) {
e2ba98a1	201	# notabene: 0700 is for making readable in the first place,
037c8c09	202	# it's also intended to change it to writable in case we have
	203	# to recurse in which case we are better than rm -rf for
	204	# subtrees with strange permissions
e2ba98a1	205	chmod($rp \| 0700, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
037c8c09	206	or carp "Can't make directory $root read+writeable: $!"
	207	unless $safe;
	208
ff21075d	209	if (opendir my $d, $root) {
7068481f	210	no strict 'refs';
	211	if (!defined ${"\cTAINT"} or ${"\cTAINT"}) {
	212	# Blindly untaint dir names
	213	@files = map { /^(.*)$/s ; $1 } readdir $d;
	214	} else {
	215	@files = readdir $d;
	216	}
ff21075d	217	closedir $d;
	218	}
	219	else {
	220	carp "Can't read $root: $!";
	221	@files = ();
	222	}
037c8c09	223
	224	# Deleting large numbers of files from VMS Files-11 filesystems
	225	# is faster if done in reverse ASCIIbetical order
	226	@files = reverse @files if $Is_VMS;
1b1e14d3	227	($root = VMS::Filespec::unixify($root)) =~ s#\.dir\z## if $Is_VMS;
ffb9ee5f	228	if ($Is_MacOS) {
	229	@files = map("$root$_", @files);
	230	} else {
	231	@files = map("$root/$_", grep $_!~/^\.{1,2}\z/s,@files);
	232	}
037c8c09	233	$count += rmtree(\@files,$verbose,$safe);
	234	if ($safe &&
	235	($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
	236	print "skipped $root\n" if $verbose;
	237	next;
	238	}
e2ba98a1	239	chmod $rp \| 0700, $root
037c8c09	240	or carp "Can't make directory $root writeable: $!"
	241	if $force_writeable;
	242	print "rmdir $root\n" if $verbose;
96e4d5b1	243	if (rmdir $root) {
	244	++$count;
	245	}
	246	else {
	247	carp "Can't remove directory $root: $!";
	248	chmod($rp, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
	249	or carp("and can't restore permissions to "
	250	. sprintf("0%o",$rp) . "\n");
	251	}
037c8c09	252	}
	253	else {
	254	if ($safe &&
64f6ddac	255	($Is_VMS ? !&VMS::Filespec::candelete($root)
	256	: !(-l $root \|\| -w $root)))
	257	{
037c8c09	258	print "skipped $root\n" if $verbose;
	259	next;
	260	}
e2ba98a1	261	chmod $rp \| 0600, $root
037c8c09	262	or carp "Can't make file $root writeable: $!"
	263	if $force_writeable;
	264	print "unlink $root\n" if $verbose;
	265	# delete all versions under VMS
94d4f21c	266	for (;;) {
94d4f21c	267	unless (unlink $root) {
96e4d5b1	268	carp "Can't unlink file $root: $!";
	269	if ($force_writeable) {
	270	chmod $rp, $root
	271	or carp("and can't restore permissions to "
	272	. sprintf("0%o",$rp) . "\n");
	273	}
94d4f21c	274	last;
96e4d5b1	275	}
94d4f21c	276	++$count;
94d4f21c	277	last unless $Is_VMS && lstat $root;
037c8c09	278	}
037c8c09	279	}
fed7345c	280	}
	281
	282	$count;
	283	}
	284
	285	1;