Update File::Path

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

diff --git a/lib/File/Path.pm b/lib/File/Path.pm
index edec55d..e086028 100644 (file)
--- 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__

diff --git a/t/lib/filepath.t b/t/lib/filepath.t
index c014f74..c3bf4a4 100755 (executable)
--- a/t/lib/filepath.t
+++ b/t/lib/filepath.t
@@ -5,16 +5,24 @@ BEGIN {
     @INC = '../lib';
 }
 
-print "1..2\n";
-
 use File::Path;
+use strict;
+
+my $count = 0;
+$^W = 1;
 
-mkpath("foo/bar");
+print "1..4\n";
 
-print "not " unless -d "foo" && -d "foo/bar";
-print "ok 1\n";
+# first check for stupid permissions second for full, so we clean up
+# behind ourselves
+for my $perm (0111,0777) {
+    mkpath("foo/bar");
+    chmod $perm, "foo", "foo/bar";
 
-rmtree("foo");
+    print "not " unless -d "foo" && -d "foo/bar";
+    print "ok ", ++$count, "\n";
 
-print "not " if -e "foo";
-print "ok 2\n";
+    rmtree("foo");
+    print "not " if -e "foo";
+    print "ok ", ++$count, "\n";
+}