Resync with mainline

[p5sagit/p5-mst-13.2.git] / lib / File / Path.pm

diff --git a/lib/File/Path.pm b/lib/File/Path.pm
index 43856df..59b72ba 100644 (file)
--- a/lib/File/Path.pm
+++ b/lib/File/Path.pm
@@ -2,15 +2,14 @@ package File::Path;
 
 =head1 NAME
 
-File::Path - create or remove a series of directories
+File::Path - create or remove directory trees
 
 =head1 SYNOPSIS
 
-C<use File::Path>
+    use File::Path;
 
-C<mkpath(['/foo/bar/baz', 'blurfl/quux'], 1, 0711);>
-
-C<rmtree(['foo/bar/baz', 'blurfl/quux'], 1, 1);>
+    mkpath(['/foo/bar/baz', 'blurfl/quux'], 1, 0711);
+    rmtree(['foo/bar/baz', 'blurfl/quux'], 1, 1);
 
 =head1 DESCRIPTION
 
@@ -88,30 +87,25 @@ in situations where security is an issue.
 =head1 AUTHORS
 
 Tim Bunce <F<Tim.Bunce@ig.co.uk>> and
-Charles Bailey <F<bailey@genetics.upenn.edu>>
-
-=head1 REVISION
-
-Current $VERSION is 1.04.
+Charles Bailey <F<bailey@newman.upenn.edu>>
 
 =cut
 
+use 5.005_64;
 use Carp;
 use File::Basename ();
-use DirHandle ();
 use Exporter ();
 use strict;
 
-use vars qw( $VERSION @ISA @EXPORT );
-$VERSION = "1.04";
-@ISA = qw( Exporter );
-@EXPORT = qw( mkpath rmtree );
+our $VERSION = "1.0403";
+our @ISA = qw( Exporter );
+our @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'
+my $force_writeable = ($^O eq 'os2' || $^O eq 'dos' || $^O eq 'MSWin32'
                       || $^O eq 'amigaos');
 
 sub mkpath {
@@ -124,15 +118,22 @@ sub mkpath {
     $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;
        # 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);
+       # 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));
+           }
+       }
        print "mkdir $path\n" if $verbose;
        unless (mkdir($path,$mode)) {
+           my $e = $!;
            # allow for another process to have created it meanwhile
-           croak "mkdir $path: $!" unless -d $path;
+           croak "mkdir $path: $e" unless -d $path;
        }
        push(@created, $path);
     }
@@ -143,10 +144,17 @@ sub rmtree {
     my($roots, $verbose, $safe) = @_;
     my(@files);
     my($count) = 0;
-    $roots = [$roots] unless ref $roots;
     $verbose ||= 0;
     $safe ||= 0;
 
+    if ( defined($roots) && length($roots) ) {
+      $roots = [$roots] unless ref $roots;
+    }
+    else {
+      carp "No root path(s) specified\n";
+      return 0;
+    }
+
     my($root);
     foreach $root (@{$roots}) {
        $root =~ s#/$##;
@@ -161,10 +169,14 @@ sub rmtree {
              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 
@@ -202,18 +214,18 @@ sub rmtree {
                if $force_writeable;
            print "unlink $root\n" if $verbose;
            # delete all versions under VMS
-           while (-e $root || -l $root) {
-               if (unlink $root) {
-                   ++$count;
-               }
-               else {
+           for (;;) {
+               unless (unlink $root) {
                    carp "Can't unlink file $root: $!";
                    if ($force_writeable) {
                        chmod $rp, $root
                            or carp("and can't restore permissions to "
                                    . sprintf("0%o",$rp) . "\n");
                    }
+                   last;
                }
+               ++$count;
+               last unless $Is_VMS && lstat $root;
            }
        }
     }