Update File::Path

(this is the same change as commit 8a37cc0e712cfd90de4a433c1b9be391b72daf86, but as applied)

1 files changed, 76 insertions, 57 deletions

diff --git a/lib/File/Path.pm b/lib/File/Path.pm
index edec55d308..e086028300 100644
--- a/lib/File/Path.pm
+++ b/lib/File/Path.pm
@@ -14,9 +14,9 @@ C<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:
+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
 
@@ -38,8 +38,8 @@ the numeric mode to use when creating the directories
 
 =back
 
-It returns a list of all directories (including intermediates, determined using
-the Unix '/' separator) created.
+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>.
@@ -83,22 +83,25 @@ Charles Bailey E<lt>F<bailey@genetics.upenn.edu>E<gt>
 
 =head1 REVISION
 
-This module was last revised 14-Feb-1996, for perl 5.002.
-$VERSION is 1.0101.
+Current $VERSION is 1.02.
 
 =cut
 
-require 5.000;
 use Carp;
-use File::Basename;
-require Exporter;
+use File::Basename ();
+use DirHandle ();
+use Exporter ();
+use strict;
 
 use vars qw( $VERSION @ISA @EXPORT );
-$VERSION = "1.0101";
+$VERSION = "1.02";
 @ISA = qw( Exporter );
 @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 'msdos' || $^O eq 'MSWin32'
 		       || $^O eq 'amigaos');
 
@@ -110,16 +113,16 @@ sub mkpath {
     local($")="/";
     $mode = 0777 unless defined($mode);
     $paths = [$paths] unless ref $paths;
-    my(@created);
+    my(@created,$path);
     foreach $path (@$paths) {
-        next if -d $path;
-        # Logic wants Unix paths, so go with the flow.
-        $path = VMS::Filespec::unixify($path) if $Is_VMS;
-        my $parent = dirname($path);
-        push(@created,mkpath($parent, $verbose, $mode)) unless (-d $parent);
-        print "mkdir $path\n" if $verbose;
-        mkdir($path,$mode) || croak "mkdir $path: $!";
-        push(@created, $path);
+	next if -d $path;
+	# Logic wants Unix paths, so go with the flow.
+	$path = VMS::Filespec::unixify($path) if $Is_VMS;
+	my $parent = File::Basename::dirname($path);
+	push(@created,mkpath($parent, $verbose, $mode)) unless (-d $parent);
+	print "mkdir $path\n" if $verbose;
+	mkdir($path,$mode) || croak "mkdir $path: $!";
+	push(@created, $path);
     }
     @created;
 }
@@ -129,48 +132,64 @@ sub rmtree {
     my(@files);
     my($count) = 0;
     $roots = [$roots] unless ref $roots;
+    $verbose ||= 0;
+    $safe ||= 0;
 
+    my($root);
     foreach $root (@{$roots}) {
-       $root =~ s#/$##;
-       if (not -l $root and -d _) { 
-           opendir(D,$root);
-           @files = readdir(D);
-           closedir(D);
-           # 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$## if $Is_VMS;
-           @files = map("$root/$_", grep $_!~/^\.{1,2}$/,@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;
-           (rmdir $root && ++$count) or carp "Can't remove directory $root: $!";
-        }
-        else { 
-           if ($safe &&
-               ($Is_VMS ? !&VMS::Filespec::candelete($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;
-           while (-e $root || -l $root) { # delete all versions under VMS
-               (unlink($root) && ++$count)
-                   or croak "Can't unlink file $root: $!";
-           }
-        }
+	$root =~ s#/$##;
+	$count++, next unless -e $root;
+	if (not -l $root and -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, $root
+	      or carp "Can't make directory $root read+writeable: $!"
+		unless $safe;
+
+	    my $d = DirHandle->new($root)
+	      or carp "Can't read $root: $!";
+	    @files = $d->read;
+	    $d->close;
+
+	    # 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$## if $Is_VMS;
+	    @files = map("$root/$_", grep $_!~/^\.{1,2}$/,@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;
+	    rmdir($root) && ++$count
+	      or carp "Can't remove directory $root: $!";
+	}
+	else { 
+	    if ($safe &&
+		($Is_VMS ? !&VMS::Filespec::candelete($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
+	    while (-e $root || -l $root) {
+		unlink($root) && ++$count
+		  or croak "Can't unlink file $root: $!";
+	    }
+	}
     }
 
     $count;
 }
 
 1;
-
-__END__