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

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
	43	Similarly, the C<rmtree> function provides a convenient way to delete a
	44	subtree from the directory structure, much like the Unix command C<rm -r>.
	45	C<rmtree> takes three arguments:
	46
	47	=over 4
	48
	49	=item *
	50
	51	the root of the subtree to delete, or a reference to
	52	a list of roots. All of the files and directories
	53	below each root, as well as the roots themselves,
567d72c2	54	will be deleted.
fed7345c	55
	56	=item *
	57
	58	a boolean value, which if TRUE will cause C<rmtree> to
748a9306	59	print a message each time it examines a file, giving the
	60	name of the file, and indicating whether it's using C<rmdir>
	61	or C<unlink> to remove it, or that it's skipping it.
fed7345c	62	(defaults to FALSE)
	63
	64	=item *
	65
	66	a boolean value, which if TRUE will cause C<rmtree> to
748a9306	67	skip any files to which you do not have delete access
	68	(if running under VMS) or write access (if running
	69	under another OS). This will change in the future when
	70	a criterion for 'delete permission' under OSs other
96e4d5b1	71	than VMS is settled. (defaults to FALSE)
fed7345c	72
	73	=back
	74
96e4d5b1	75	It returns the number of files successfully deleted. Symlinks are
341bd822	76	simply deleted and not followed.
fed7345c	77
96e4d5b1	78	B<NOTE:> If the third parameter is not TRUE, C<rmtree> is B<unsecure>
	79	in the face of failure or interruption. Files and directories which
	80	were not deleted may be left with permissions reset to allow world
	81	read and write access. Note also that the occurrence of errors in
	82	rmtree can be determined I<only> by trapping diagnostic messages
	83	using C<$SIG{__WARN__}>; it is not apparent from the return value.
	84	Therefore, you must be extremely careful about using C<rmtree($foo,$bar,0>
	85	in situations where security is an issue.
	86
fed7345c	87	=head1 AUTHORS
fed7345c	88
96e4d5b1	89	Tim Bunce <F<Tim.Bunce@ig.co.uk>> and
bd3fa61c	90	Charles Bailey <F<bailey@newman.upenn.edu>>
fed7345c	91
fed7345c	92	=cut
fed7345c	93
3b825e41	94	use 5.006;
fed7345c	95	use Carp;
037c8c09	96	use File::Basename ();
037c8c09	97	use Exporter ();
037c8c09	98	use strict;
b395063c	99	use warnings;
68dc0745	100
7068481f	101	our $VERSION = "1.05";
ff21075d	102	our @ISA = qw( Exporter );
ff21075d	103	our @EXPORT = qw( mkpath rmtree );
fed7345c	104
68dc0745	105	my $Is_VMS = $^O eq 'VMS';
ffb9ee5f	106	my $Is_MacOS = $^O eq 'MacOS';
037c8c09	107
	108	# These OSes complain if you want to remove a file that you have no
	109	# write permission to:
6d697788	110	my $force_writeable = ($^O eq 'os2' \|\| $^O eq 'dos' \|\| $^O eq 'MSWin32' \|\|
fa6a1c44	111	$^O eq 'amigaos' \|\| $^O eq 'MacOS' \|\| $^O eq 'epoc');
748a9306	112
a5f75d66	113	sub mkpath {
fed7345c	114	my($paths, $verbose, $mode) = @_;
	115	# $paths -- either a path string or ref to list of paths
	116	# $verbose -- optional print "mkdir $path" for each directory created
	117	# $mode -- optional permissions, defaults to 0777
ffb9ee5f	118	local($")=$Is_MacOS ? ":" : "/";
fed7345c	119	$mode = 0777 unless defined($mode);
fed7345c	120	$paths = [$paths] unless ref $paths;
037c8c09	121	my(@created,$path);
68dc0745	122	foreach $path (@$paths) {
1b1e14d3	123	$path .= '/' if $^O eq 'os2' and $path =~ /^\w:\z/s; # feature of CRT
037c8c09	124	# Logic wants Unix paths, so go with the flow.
e3830a4e	125	if ($Is_VMS) {
	126	next if $path eq '/';
	127	$path = VMS::Filespec::unixify($path);
	128	if ($path =~ m:^(/[^/]+)/?\z:) {
	129	$path = $1.'/000000';
c3420933	130	}
491527d0	131	}
e3830a4e	132	next if -d $path;
	133	my $parent = File::Basename::dirname($path);
	134	unless (-d $parent or $path eq $parent) {
	135	push(@created,mkpath($parent, $verbose, $mode));
	136	}
037c8c09	137	print "mkdir $path\n" if $verbose;
67e4c828	138	unless (mkdir($path,$mode)) {
c3420933	139	my $e = $!;
	140	# allow for another process to have created it meanwhile
	141	croak "mkdir $path: $e" unless -d $path;
67e4c828	142	}
037c8c09	143	push(@created, $path);
fed7345c	144	}
	145	@created;
	146	}
	147
	148	sub rmtree {
	149	my($roots, $verbose, $safe) = @_;
7301ec2d	150	my(@files);
7301ec2d	151	my($count) = 0;
037c8c09	152	$verbose \|\|= 0;
037c8c09	153	$safe \|\|= 0;
fed7345c	154
ee79a11f	155	if ( defined($roots) && length($roots) ) {
	156	$roots = [$roots] unless ref $roots;
	157	}
	158	else {
	159	carp "No root path(s) specified\n";
	160	return 0;
	161	}
	162
037c8c09	163	my($root);
fed7345c	164	foreach $root (@{$roots}) {
ffb9ee5f	165	if ($Is_MacOS) {
	166	$root = ":$root" if $root !~ /:/;
	167	$root =~ s#([^:])\z#$1:#;
	168	} else {
	169	$root =~ s#/\z##;
	170	}
7025f710	171	(undef, undef, my $rp) = lstat $root or next;
	172	$rp &= 07777; # don't forget setuid, setgid, sticky bits
	173	if ( -d _ ) {
037c8c09	174	# notabene: 0777 is for making readable in the first place,
	175	# it's also intended to change it to writable in case we have
	176	# to recurse in which case we are better than rm -rf for
	177	# subtrees with strange permissions
96e4d5b1	178	chmod(0777, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
037c8c09	179	or carp "Can't make directory $root read+writeable: $!"
	180	unless $safe;
	181
ff21075d	182	if (opendir my $d, $root) {
7068481f	183	no strict 'refs';
	184	if (!defined ${"\cTAINT"} or ${"\cTAINT"}) {
	185	# Blindly untaint dir names
	186	@files = map { /^(.*)$/s ; $1 } readdir $d;
	187	} else {
	188	@files = readdir $d;
	189	}
ff21075d	190	closedir $d;
	191	}
	192	else {
	193	carp "Can't read $root: $!";
	194	@files = ();
	195	}
037c8c09	196
	197	# Deleting large numbers of files from VMS Files-11 filesystems
	198	# is faster if done in reverse ASCIIbetical order
	199	@files = reverse @files if $Is_VMS;
1b1e14d3	200	($root = VMS::Filespec::unixify($root)) =~ s#\.dir\z## if $Is_VMS;
ffb9ee5f	201	if ($Is_MacOS) {
	202	@files = map("$root$_", @files);
	203	} else {
	204	@files = map("$root/$_", grep $_!~/^\.{1,2}\z/s,@files);
	205	}
037c8c09	206	$count += rmtree(\@files,$verbose,$safe);
	207	if ($safe &&
	208	($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
	209	print "skipped $root\n" if $verbose;
	210	next;
	211	}
	212	chmod 0777, $root
	213	or carp "Can't make directory $root writeable: $!"
	214	if $force_writeable;
	215	print "rmdir $root\n" if $verbose;
96e4d5b1	216	if (rmdir $root) {
	217	++$count;
	218	}
	219	else {
	220	carp "Can't remove directory $root: $!";
	221	chmod($rp, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
	222	or carp("and can't restore permissions to "
	223	. sprintf("0%o",$rp) . "\n");
	224	}
037c8c09	225	}
	226	else {
	227	if ($safe &&
64f6ddac	228	($Is_VMS ? !&VMS::Filespec::candelete($root)
	229	: !(-l $root \|\| -w $root)))
	230	{
037c8c09	231	print "skipped $root\n" if $verbose;
	232	next;
	233	}
	234	chmod 0666, $root
	235	or carp "Can't make file $root writeable: $!"
	236	if $force_writeable;
	237	print "unlink $root\n" if $verbose;
	238	# delete all versions under VMS
94d4f21c	239	for (;;) {
94d4f21c	240	unless (unlink $root) {
96e4d5b1	241	carp "Can't unlink file $root: $!";
	242	if ($force_writeable) {
	243	chmod $rp, $root
	244	or carp("and can't restore permissions to "
	245	. sprintf("0%o",$rp) . "\n");
	246	}
94d4f21c	247	last;
96e4d5b1	248	}
94d4f21c	249	++$count;
94d4f21c	250	last unless $Is_VMS && lstat $root;
037c8c09	251	}
037c8c09	252	}
fed7345c	253	}
	254
	255	$count;
	256	}
	257
	258	1;