[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.005_64;
use Carp;
use File::Basename ();
use Exporter ();
use strict;

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

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

# 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');

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