[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 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.05";
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.
	93	Therefore, you must be extremely careful about using C<rmtree($foo,$bar,0>
	94	in situations where security is an issue.
	95
fed7345c	96	=head1 AUTHORS
fed7345c	97
96e4d5b1	98	Tim Bunce <F<Tim.Bunce@ig.co.uk>> and
bd3fa61c	99	Charles Bailey <F<bailey@newman.upenn.edu>>
fed7345c	100
fed7345c	101	=cut
fed7345c	102
3b825e41	103	use 5.006;
fed7345c	104	use Carp;
037c8c09	105	use File::Basename ();
037c8c09	106	use Exporter ();
037c8c09	107	use strict;
b395063c	108	use warnings;
68dc0745	109
7068481f	110	our $VERSION = "1.05";
ff21075d	111	our @ISA = qw( Exporter );
ff21075d	112	our @EXPORT = qw( mkpath rmtree );
fed7345c	113
68dc0745	114	my $Is_VMS = $^O eq 'VMS';
ffb9ee5f	115	my $Is_MacOS = $^O eq 'MacOS';
037c8c09	116
	117	# These OSes complain if you want to remove a file that you have no
	118	# write permission to:
6d697788	119	my $force_writeable = ($^O eq 'os2' \|\| $^O eq 'dos' \|\| $^O eq 'MSWin32' \|\|
fa6a1c44	120	$^O eq 'amigaos' \|\| $^O eq 'MacOS' \|\| $^O eq 'epoc');
748a9306	121
a5f75d66	122	sub mkpath {
fed7345c	123	my($paths, $verbose, $mode) = @_;
	124	# $paths -- either a path string or ref to list of paths
	125	# $verbose -- optional print "mkdir $path" for each directory created
	126	# $mode -- optional permissions, defaults to 0777
ffb9ee5f	127	local($")=$Is_MacOS ? ":" : "/";
fed7345c	128	$mode = 0777 unless defined($mode);
fed7345c	129	$paths = [$paths] unless ref $paths;
037c8c09	130	my(@created,$path);
68dc0745	131	foreach $path (@$paths) {
1b1e14d3	132	$path .= '/' if $^O eq 'os2' and $path =~ /^\w:\z/s; # feature of CRT
037c8c09	133	# Logic wants Unix paths, so go with the flow.
e3830a4e	134	if ($Is_VMS) {
	135	next if $path eq '/';
	136	$path = VMS::Filespec::unixify($path);
	137	if ($path =~ m:^(/[^/]+)/?\z:) {
	138	$path = $1.'/000000';
c3420933	139	}
491527d0	140	}
e3830a4e	141	next if -d $path;
	142	my $parent = File::Basename::dirname($path);
	143	unless (-d $parent or $path eq $parent) {
	144	push(@created,mkpath($parent, $verbose, $mode));
	145	}
037c8c09	146	print "mkdir $path\n" if $verbose;
67e4c828	147	unless (mkdir($path,$mode)) {
c3420933	148	my $e = $!;
	149	# allow for another process to have created it meanwhile
	150	croak "mkdir $path: $e" unless -d $path;
67e4c828	151	}
037c8c09	152	push(@created, $path);
fed7345c	153	}
	154	@created;
	155	}
	156
	157	sub rmtree {
	158	my($roots, $verbose, $safe) = @_;
7301ec2d	159	my(@files);
7301ec2d	160	my($count) = 0;
037c8c09	161	$verbose \|\|= 0;
037c8c09	162	$safe \|\|= 0;
fed7345c	163
ee79a11f	164	if ( defined($roots) && length($roots) ) {
	165	$roots = [$roots] unless ref $roots;
	166	}
	167	else {
	168	carp "No root path(s) specified\n";
	169	return 0;
	170	}
	171
037c8c09	172	my($root);
fed7345c	173	foreach $root (@{$roots}) {
ffb9ee5f	174	if ($Is_MacOS) {
	175	$root = ":$root" if $root !~ /:/;
	176	$root =~ s#([^:])\z#$1:#;
	177	} else {
	178	$root =~ s#/\z##;
	179	}
7025f710	180	(undef, undef, my $rp) = lstat $root or next;
	181	$rp &= 07777; # don't forget setuid, setgid, sticky bits
	182	if ( -d _ ) {
037c8c09	183	# notabene: 0777 is for making readable in the first place,
	184	# it's also intended to change it to writable in case we have
	185	# to recurse in which case we are better than rm -rf for
	186	# subtrees with strange permissions
96e4d5b1	187	chmod(0777, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
037c8c09	188	or carp "Can't make directory $root read+writeable: $!"
	189	unless $safe;
	190
ff21075d	191	if (opendir my $d, $root) {
7068481f	192	no strict 'refs';
	193	if (!defined ${"\cTAINT"} or ${"\cTAINT"}) {
	194	# Blindly untaint dir names
	195	@files = map { /^(.*)$/s ; $1 } readdir $d;
	196	} else {
	197	@files = readdir $d;
	198	}
ff21075d	199	closedir $d;
	200	}
	201	else {
	202	carp "Can't read $root: $!";
	203	@files = ();
	204	}
037c8c09	205
	206	# Deleting large numbers of files from VMS Files-11 filesystems
	207	# is faster if done in reverse ASCIIbetical order
	208	@files = reverse @files if $Is_VMS;
1b1e14d3	209	($root = VMS::Filespec::unixify($root)) =~ s#\.dir\z## if $Is_VMS;
ffb9ee5f	210	if ($Is_MacOS) {
	211	@files = map("$root$_", @files);
	212	} else {
	213	@files = map("$root/$_", grep $_!~/^\.{1,2}\z/s,@files);
	214	}
037c8c09	215	$count += rmtree(\@files,$verbose,$safe);
	216	if ($safe &&
	217	($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
	218	print "skipped $root\n" if $verbose;
	219	next;
	220	}
	221	chmod 0777, $root
	222	or carp "Can't make directory $root writeable: $!"
	223	if $force_writeable;
	224	print "rmdir $root\n" if $verbose;
96e4d5b1	225	if (rmdir $root) {
	226	++$count;
	227	}
	228	else {
	229	carp "Can't remove directory $root: $!";
	230	chmod($rp, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
	231	or carp("and can't restore permissions to "
	232	. sprintf("0%o",$rp) . "\n");
	233	}
037c8c09	234	}
	235	else {
	236	if ($safe &&
64f6ddac	237	($Is_VMS ? !&VMS::Filespec::candelete($root)
	238	: !(-l $root \|\| -w $root)))
	239	{
037c8c09	240	print "skipped $root\n" if $verbose;
	241	next;
	242	}
	243	chmod 0666, $root
	244	or carp "Can't make file $root writeable: $!"
	245	if $force_writeable;
	246	print "unlink $root\n" if $verbose;
	247	# delete all versions under VMS
94d4f21c	248	for (;;) {
94d4f21c	249	unless (unlink $root) {
96e4d5b1	250	carp "Can't unlink file $root: $!";
	251	if ($force_writeable) {
	252	chmod $rp, $root
	253	or carp("and can't restore permissions to "
	254	. sprintf("0%o",$rp) . "\n");
	255	}
94d4f21c	256	last;
96e4d5b1	257	}
94d4f21c	258	++$count;
94d4f21c	259	last unless $Is_VMS && lstat $root;
037c8c09	260	}
037c8c09	261	}
fed7345c	262	}
	263
	264	$count;
	265	}
	266
	267	1;