Upgrade DB_File to 1.56:
[p5sagit/p5-mst-13.2.git] / lib / File / Path.pm
index 419bd03..43856df 100644 (file)
@@ -92,7 +92,7 @@ Charles Bailey <F<bailey@genetics.upenn.edu>>
 
 =head1 REVISION
 
-Current $VERSION is 1.03.
+Current $VERSION is 1.04.
 
 =cut
 
@@ -103,7 +103,7 @@ use Exporter ();
 use strict;
 
 use vars qw( $VERSION @ISA @EXPORT );
-$VERSION = "1.03";
+$VERSION = "1.04";
 @ISA = qw( Exporter );
 @EXPORT = qw( mkpath rmtree );
 
@@ -130,7 +130,10 @@ sub mkpath {
        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: $!";
+       unless (mkdir($path,$mode)) {
+           # allow for another process to have created it meanwhile
+           croak "mkdir $path: $!" unless -d $path;
+       }
        push(@created, $path);
     }
     @created;
@@ -147,13 +150,13 @@ sub rmtree {
     my($root);
     foreach $root (@{$roots}) {
        $root =~ s#/$##;
-       next unless -e $root;
-       if (not -l $root and -d _) {
+       (undef, undef, my $rp) = lstat $root or next;
+       $rp &= 07777;   # don't forget setuid, setgid, sticky bits
+       if ( -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
-           my $rp = (stat(_))[2] & 0777;  #Is this portable???
            chmod(0777, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
              or carp "Can't make directory $root read+writeable: $!"
                unless $safe;
@@ -194,7 +197,6 @@ sub rmtree {
                print "skipped $root\n" if $verbose;
                next;
            }
-           my $rp = (stat(_))[2] & 0777;  #Is this portable???
            chmod 0666, $root
              or carp "Can't make file $root writeable: $!"
                if $force_writeable;