From: Chip Salzenberg Date: Mon, 14 Apr 1997 12:00:00 +0000 (+1200) Subject: Update File::Path X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=037c8c09c49af754e50cc4c5213c0e178ecdd87d;p=p5sagit%2Fp5-mst-13.2.git 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 --- a/lib/File/Path.pm +++ b/lib/File/Path.pm @@ -14,9 +14,9 @@ C =head1 DESCRIPTION -The C function provides a convenient way to create directories, even if -your C kernel call won't create more than one level of directory at a -time. C takes three arguments: +The C function provides a convenient way to create directories, even +if your C kernel call won't create more than one level of directory at +a time. C 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 function provides a convenient way to delete a subtree from the directory structure, much like the Unix command C. @@ -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,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 --- 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"; +}