From 8a37cc0e712cfd90de4a433c1b9be391b72daf86 Mon Sep 17 00:00:00 2001 From: Andreas Koenig Date: Tue, 15 Apr 1997 16:01:07 +0200 Subject: [PATCH] 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. 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 --- lib/File/Path.pm | 39 +++++++++++++++++++++++++++------------ t/lib/filepath.t | 24 ++++++++++++++++-------- 2 files changed, 43 insertions(+), 20 deletions(-) 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 EFE =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"; +} -- 2.7.4