X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FFile%2FPath.pm;h=46af24fdb2027caf70084a79e989ba8dae84bd23;hb=35c0985d87e203a100f5c5fc6518bee6a2e2fd9d;hp=daa2eae0fb745056747c2f0640b4285512458f3b;hpb=6d697788dfbbf5dba78216c0da10ca1dce806bbe;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/File/Path.pm b/lib/File/Path.pm
index daa2eae..46af24f 100644
--- a/lib/File/Path.pm
+++ b/lib/File/Path.pm
@@ -40,6 +40,15 @@ the numeric mode to use when creating the directories
 It returns a list of all directories (including intermediates, determined
 using the Unix '/' separator) created.
 
+If a system error prevents a directory from being created, then the
+C<mkpath> function throws a fatal error with C<Carp::croak>. This error
+can be trapped with an C<eval> block:
+
+  eval { mkpath($dir) };
+  if ($@) {
+    print "Couldn't create $dir: $@";
+  }
+
 Similarly, the C<rmtree> function provides a convenient way to delete a
 subtree from the directory structure, much like the Unix command C<rm -r>.
 C<rmtree> takes three arguments:
@@ -91,44 +100,49 @@ Charles Bailey <F<bailey@newman.upenn.edu>>
 
 =cut
 
-use 5.005_64;
+use 5.006;
 use Carp;
 use File::Basename ();
 use Exporter ();
 use strict;
+use warnings;
 
-our $VERSION = "1.0403";
+our $VERSION = "1.05";
 our @ISA = qw( Exporter );
 our @EXPORT = qw( mkpath rmtree );
 
 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:
 my $force_writeable = ($^O eq 'os2' || $^O eq 'dos' || $^O eq 'MSWin32' ||
-		       $^O eq 'amigaos' || $^O eq 'MacOS');
+		       $^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
-    local($")="/";
+    local($")=$Is_MacOS ? ":" : "/";
     $mode = 0777 unless defined($mode);
     $paths = [$paths] unless ref $paths;
     my(@created,$path);
     foreach $path (@$paths) {
 	$path .= '/' if $^O eq 'os2' and $path =~ /^\w:\z/s; # 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);
-	# 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 = $!;
@@ -157,7 +171,12 @@ sub rmtree {
 
     my($root);
     foreach $root (@{$roots}) {
-	$root =~ s#/\z##;
+    	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 _ ) {
@@ -170,7 +189,13 @@ sub rmtree {
 		unless $safe;
 
 	    if (opendir my $d, $root) {
-		@files = readdir $d;
+		no strict 'refs';
+		if (!defined ${"\cTAINT"} or ${"\cTAINT"}) {
+		    # Blindly untaint dir names
+		    @files = map { /^(.*)$/s ; $1 } readdir $d;
+		} else {
+		    @files = readdir $d;
+		}
 		closedir $d;
 	    }
 	    else {
@@ -182,7 +207,11 @@ sub rmtree {
 	    # is faster if done in reverse ASCIIbetical order 
 	    @files = reverse @files if $Is_VMS;
 	    ($root = VMS::Filespec::unixify($root)) =~ s#\.dir\z## if $Is_VMS;
-	    @files = map("$root/$_", grep $_!~/^\.{1,2}\z/s,@files);
+	    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)) {