Integrate changes #9259,9260 from maintperl into mainline.

[perl5.git] / lib / File / Path.pm

diff --git a/lib/File/Path.pm b/lib/File/Path.pm
index 634b2cd..0eb6128 100644 (file)
--- a/lib/File/Path.pm
+++ b/lib/File/Path.pm
@@ -73,7 +73,7 @@ than VMS is settled.  (defaults to FALSE)
 =back
 
 It returns the number of files successfully deleted.  Symlinks are
 =back
 
 It returns the number of files successfully deleted.  Symlinks are

-treated as ordinary files.
+simply deleted and not followed.

 
 B<NOTE:> If the third parameter is not TRUE, C<rmtree> is B<unsecure>
 in the face of failure or interruption.  Files and directories which
 
 B<NOTE:> If the third parameter is not TRUE, C<rmtree> is B<unsecure>
 in the face of failure or interruption.  Files and directories which


@@ -91,45 +91,48 @@ Charles Bailey <F<bailey@newman.upenn.edu>>
 
 =cut
 
 
 =cut
 

+use 5.005_64;

 use Carp;
 use File::Basename ();
 use Carp;
 use File::Basename ();

-use DirHandle ();

 use Exporter ();
 use strict;
 
 use Exporter ();
 use strict;
 

-use vars qw( $VERSION @ISA @EXPORT );
-$VERSION = "1.0402";
-@ISA = qw( Exporter );
-@EXPORT = qw( mkpath rmtree );
+our $VERSION = "1.0404";
+our @ISA = qw( Exporter );
+our @EXPORT = qw( mkpath rmtree );

 
 my $Is_VMS = $^O eq 'VMS';
 
 my $Is_VMS = $^O eq 'VMS';

+my $Is_MacOS = $^O eq 'MacOS';

 
 # These OSes complain if you want to remove a file that you have no
 # write permission to:
 
 # 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 'dos' || $^O eq 'MSWin32'
-                      || $^O eq 'amigaos');
+my $force_writeable = ($^O eq 'os2' || $^O eq 'dos' || $^O eq 'MSWin32' ||
+                      $^O eq 'amigaos' || $^O eq 'MacOS' || $^O eq 'epoc');

 
 sub mkpath {
     my($paths, $verbose, $mode) = @_;
     # $paths   -- either a path string or ref to list of paths
     # $verbose -- optional print "mkdir $path" for each directory created
     # $mode    -- optional permissions, defaults to 0777
 
 sub mkpath {
     my($paths, $verbose, $mode) = @_;
     # $paths   -- either a path string or ref to list of paths
     # $verbose -- optional print "mkdir $path" for each directory created
     # $mode    -- optional permissions, defaults to 0777

-    local($")="/";
+    local($")=$Is_MacOS ? ":" : "/";

     $mode = 0777 unless defined($mode);
     $paths = [$paths] unless ref $paths;
     my(@created,$path);
     foreach $path (@$paths) {
     $mode = 0777 unless defined($mode);
     $paths = [$paths] unless ref $paths;
     my(@created,$path);
     foreach $path (@$paths) {

-       $path .= '/' if $^O eq 'os2' and $path =~ /^\w:$/; # feature of CRT 
-       next if -d $path;
+       $path .= '/' if $^O eq 'os2' and $path =~ /^\w:\z/s; # feature of CRT 

        # Logic wants Unix paths, so go with the flow.
        # Logic wants Unix paths, so go with the flow.

-       $path = VMS::Filespec::unixify($path) if $Is_VMS;
-       my $parent = File::Basename::dirname($path);
-       # Allow for creation of new logical filesystems under VMS
-       if (not $Is_VMS or $parent !~ m:/[^/]+/000000/?:) {
-           unless (-d $parent or $path eq $parent) {
-               push(@created,mkpath($parent, $verbose, $mode));
+       if ($Is_VMS) {
+           next if $path eq '/';
+           $path = VMS::Filespec::unixify($path);
+           if ($path =~ m:^(/[^/]+)/?\z:) {
+               $path = $1.'/000000';

            }
        }
            }
        }

+       next if -d $path;
+       my $parent = File::Basename::dirname($path);
+       unless (-d $parent or $path eq $parent) {
+           push(@created,mkpath($parent, $verbose, $mode));
+       }

        print "mkdir $path\n" if $verbose;
        unless (mkdir($path,$mode)) {
            my $e = $!;
        print "mkdir $path\n" if $verbose;
        unless (mkdir($path,$mode)) {
            my $e = $!;


@@ -158,7 +161,12 @@ sub rmtree {
 
     my($root);
     foreach $root (@{$roots}) {
 
     my($root);
     foreach $root (@{$roots}) {

-       $root =~ s#/$##;
+       if ($Is_MacOS) {
+           $root = ":$root" if $root !~ /:/;
+           $root =~ s#([^:])\z#$1:#;
+       } else {
+           $root =~ s#/\z##;
+       }

        (undef, undef, my $rp) = lstat $root or next;
        $rp &= 07777;   # don't forget setuid, setgid, sticky bits
        if ( -d _ ) {
        (undef, undef, my $rp) = lstat $root or next;
        $rp &= 07777;   # don't forget setuid, setgid, sticky bits
        if ( -d _ ) {


@@ -170,16 +178,24 @@ sub rmtree {
              or carp "Can't make directory $root read+writeable: $!"
                unless $safe;
 
              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;
+           if (opendir my $d, $root) {
+               @files = readdir $d;
+               closedir $d;
+           }
+           else {
+               carp "Can't read $root: $!";
+               @files = ();
+           }

 
            # Deleting large numbers of files from VMS Files-11 filesystems
            # is faster if done in reverse ASCIIbetical order 
            @files = reverse @files if $Is_VMS;
 
            # 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);
+           ($root = VMS::Filespec::unixify($root)) =~ s#\.dir\z## if $Is_VMS;
+           if ($Is_MacOS) {
+               @files = map("$root$_", @files);
+           } else {
+               @files = map("$root/$_", grep $_!~/^\.{1,2}\z/s,@files);
+           }

            $count += rmtree(\@files,$verbose,$safe);
            if ($safe &&
                ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
            $count += rmtree(\@files,$verbose,$safe);
            if ($safe &&
                ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {


@@ -202,7 +218,9 @@ sub rmtree {
        }
        else { 
            if ($safe &&
        }
        else { 
            if ($safe &&

-               ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
+               ($Is_VMS ? !&VMS::Filespec::candelete($root)
+                        : !(-l $root || -w $root)))
+           {

                print "skipped $root\n" if $verbose;
                next;
            }
                print "skipped $root\n" if $verbose;
                next;
            }