[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)

=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:> If the third parameter is not TRUE, C<rmtree> is B<unsecure>
in the face of failure or interruption.  Files and directories which
were not deleted may be left with permissions reset to allow world
read and write access.  Note also that the occurrence of errors in
rmtree can be determined I<only> by trapping diagnostic messages
using C<$SIG{__WARN__}>; it is not apparent from the return value.
Therefore, you must be extremely careful about using C<rmtree($foo,$bar,0)>
in situations where security is an issue.

=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: 0777 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(0777, ($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 0777, $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 0666, $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
	36	(defaults to 0777)
	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
96e4d5b1	87	B<NOTE:> If the third parameter is not TRUE, C<rmtree> is B<unsecure>
	88	in the face of failure or interruption. Files and directories which
	89	were not deleted may be left with permissions reset to allow world
	90	read and write access. Note also that the occurrence of errors in
	91	rmtree can be determined I<only> by trapping diagnostic messages
	92	using C<$SIG{__WARN__}>; it is not apparent from the return value.
b6d5dbc1	93	Therefore, you must be extremely careful about using C<rmtree($foo,$bar,0)>
96e4d5b1	94	in situations where security is an issue.
96e4d5b1	95
b8d5f521	96	=head1 DIAGNOSTICS
	97
	98	=over 4
	99
	100	=item *
	101
	102	On Windows, if C<mkpath> gives you the warning: B<No such file or
	103	directory>, this may mean that you've exceeded your filesystem's
	104	maximum path length.
	105
	106	=back
	107
fed7345c	108	=head1 AUTHORS
fed7345c	109
96e4d5b1	110	Tim Bunce <F<Tim.Bunce@ig.co.uk>> and
bd3fa61c	111	Charles Bailey <F<bailey@newman.upenn.edu>>
fed7345c	112
fed7345c	113	=cut
fed7345c	114
3b825e41	115	use 5.006;
fed7345c	116	use Carp;
037c8c09	117	use File::Basename ();
037c8c09	118	use Exporter ();
037c8c09	119	use strict;
b395063c	120	use warnings;
68dc0745	121
2af1ab88	122	our $VERSION = "1.06";
ff21075d	123	our @ISA = qw( Exporter );
ff21075d	124	our @EXPORT = qw( mkpath rmtree );
fed7345c	125
68dc0745	126	my $Is_VMS = $^O eq 'VMS';
ffb9ee5f	127	my $Is_MacOS = $^O eq 'MacOS';
037c8c09	128
	129	# These OSes complain if you want to remove a file that you have no
	130	# write permission to:
6d697788	131	my $force_writeable = ($^O eq 'os2' \|\| $^O eq 'dos' \|\| $^O eq 'MSWin32' \|\|
fa6a1c44	132	$^O eq 'amigaos' \|\| $^O eq 'MacOS' \|\| $^O eq 'epoc');
748a9306	133
a5f75d66	134	sub mkpath {
fed7345c	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
ffb9ee5f	139	local($")=$Is_MacOS ? ":" : "/";
fed7345c	140	$mode = 0777 unless defined($mode);
fed7345c	141	$paths = [$paths] unless ref $paths;
037c8c09	142	my(@created,$path);
68dc0745	143	foreach $path (@$paths) {
1b1e14d3	144	$path .= '/' if $^O eq 'os2' and $path =~ /^\w:\z/s; # feature of CRT
037c8c09	145	# Logic wants Unix paths, so go with the flow.
e3830a4e	146	if ($Is_VMS) {
	147	next if $path eq '/';
	148	$path = VMS::Filespec::unixify($path);
	149	if ($path =~ m:^(/[^/]+)/?\z:) {
	150	$path = $1.'/000000';
c3420933	151	}
491527d0	152	}
e3830a4e	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	}
037c8c09	158	print "mkdir $path\n" if $verbose;
67e4c828	159	unless (mkdir($path,$mode)) {
c3420933	160	my $e = $!;
	161	# allow for another process to have created it meanwhile
	162	croak "mkdir $path: $e" unless -d $path;
67e4c828	163	}
037c8c09	164	push(@created, $path);
fed7345c	165	}
	166	@created;
	167	}
	168
	169	sub rmtree {
	170	my($roots, $verbose, $safe) = @_;
7301ec2d	171	my(@files);
7301ec2d	172	my($count) = 0;
037c8c09	173	$verbose \|\|= 0;
037c8c09	174	$safe \|\|= 0;
fed7345c	175
ee79a11f	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
037c8c09	184	my($root);
fed7345c	185	foreach $root (@{$roots}) {
ffb9ee5f	186	if ($Is_MacOS) {
	187	$root = ":$root" if $root !~ /:/;
	188	$root =~ s#([^:])\z#$1:#;
	189	} else {
	190	$root =~ s#/\z##;
	191	}
7025f710	192	(undef, undef, my $rp) = lstat $root or next;
	193	$rp &= 07777; # don't forget setuid, setgid, sticky bits
	194	if ( -d _ ) {
037c8c09	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
96e4d5b1	199	chmod(0777, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
037c8c09	200	or carp "Can't make directory $root read+writeable: $!"
	201	unless $safe;
	202
ff21075d	203	if (opendir my $d, $root) {
7068481f	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	}
ff21075d	211	closedir $d;
	212	}
	213	else {
	214	carp "Can't read $root: $!";
	215	@files = ();
	216	}
037c8c09	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;
1b1e14d3	221	($root = VMS::Filespec::unixify($root)) =~ s#\.dir\z## if $Is_VMS;
ffb9ee5f	222	if ($Is_MacOS) {
	223	@files = map("$root$_", @files);
	224	} else {
	225	@files = map("$root/$_", grep $_!~/^\.{1,2}\z/s,@files);
	226	}
037c8c09	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;
96e4d5b1	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	}
037c8c09	246	}
	247	else {
	248	if ($safe &&
64f6ddac	249	($Is_VMS ? !&VMS::Filespec::candelete($root)
	250	: !(-l $root \|\| -w $root)))
	251	{
037c8c09	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
94d4f21c	260	for (;;) {
94d4f21c	261	unless (unlink $root) {
96e4d5b1	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	}
94d4f21c	268	last;
96e4d5b1	269	}
94d4f21c	270	++$count;
94d4f21c	271	last unless $Is_VMS && lstat $root;
037c8c09	272	}
037c8c09	273	}
fed7345c	274	}
	275
	276	$count;
	277	}
	278
	279	1;