From: Andreas Koenig <a.koenig@mind.de>
Date: Tue, 15 Apr 1997 14:01:07 +0000 (+0200)
Subject: Update File::Path
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8a37cc0e712cfd90de4a433c1b9be391b72daf86;p=p5sagit%2Fp5-mst-13.2.git

Update File::Path

>>>>> Chip Salzenberg writes:

 > According to Andreas Koenig:
>> I'd prefer to have consistent semantics on all platforms. My patch
>> treats the third parameter ($safe) in a way that matches the current
>> description in the pods better. This means, on all systems a chmod +rw
>> is tried before removing a file or directory unless the $safe
>> parameter is specified.

 > No, that's not useful.  UNIX systems pay *no* attention to the
 > permissions of "x" when unlinking "/y/x"; all that matter are the
 > permissions of "/y".

Ouch. Too-Quick-oh. <Blush>

Sure thing is, I want to chmod 777 always for _directories_ before I
remove them, because they may contain subdirectories that need to be
removed recursively. So I want them both read- and writeable. Stupid
thing was that I applied the same idea to files.

>> In addition File::Path becomes strict clean.

 > Well, that would be useful.  Could you separate that part of the patch
 > from the always-chmod part?

I redid it. This time with a test that fails with current perl and
works with my patch in place.

p5p-msgid: 199704151401.QAA02556@anna.in-berlin.de
---

diff --git a/lib/File/Path.pm b/lib/File/Path.pm
index edec55d..3c249f4 100644
--- a/lib/File/Path.pm
+++ b/lib/File/Path.pm
@@ -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,12 +113,12 @@ 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);
+        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: $!";
@@ -129,13 +132,25 @@ 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);
+       $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 "Could not 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;
diff --git a/t/lib/filepath.t b/t/lib/filepath.t
index c014f74..c3bf4a4 100755
--- 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";
+}