X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FFile%2FPath.pm;h=137e7bb1ce0750e36f3faf2497a8ed7b332315f8;hb=acce7d4e04d89207299003c3e80c69d50bc82069;hp=30f550d7f414382812c84d8e317306b392ad380a;hpb=1fc4cb5503ed4e568f4cafd2aff20f315226e3bd;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/File/Path.pm b/lib/File/Path.pm
index 30f550d..137e7bb 100644
--- a/lib/File/Path.pm
+++ b/lib/File/Path.pm
@@ -52,47 +52,57 @@ C<rmtree> takes three arguments:
 the root of the subtree to delete, or a reference to
 a list of roots.  All of the files and directories
 below each root, as well as the roots themselves,
-will be deleted.  For the moment, C<rmtree> expects
-Unix file specification syntax.
+will be deleted.
 
 =item *
 
 a boolean value, which if TRUE will cause C<rmtree> to
-print a message each time it tries to delete a file,
-giving the name of the file, and indicating whether
-it's using C<rmdir> or C<unlink> to remove it.
+print a message each time it examines a file, giving the
+name of the file, and indicating whether it's using C<rmdir>
+or C<unlink> to remove it, or that it's skipping it.
 (defaults to FALSE)
 
 =item *
 
 a boolean value, which if TRUE will cause C<rmtree> to
-skip any files to which you do not have write access.
-This will change in the future when a criterion for
-'delete permission' is settled. (defaults to FALSE)
+skip any files to which you do not have delete access
+(if running under VMS) or write access (if running
+under another OS).  This will change in the future when
+a criterion for 'delete permission' under OSs other
+than VMS is settled. (defaults to FALSE)
 
 =back
 
-It returns the number of files successfully deleted.
+It returns the number of files successfully deleted. Symlinks are
+treated as ordinary files.
 
 =head1 AUTHORS
 
-Tim Bunce <Tim.Bunce@ig.co.uk>
-Charles Bailey <bailey@genetics.upenn.edu>
+Tim Bunce E<lt>F<Tim.Bunce@ig.co.uk>E<gt>
+Charles Bailey E<lt>F<bailey@genetics.upenn.edu>E<gt>
 
 =head1 REVISION
 
-This document was last revised 29-Jan-1995, for perl 5.001
+This module was last revised 14-Feb-1996, for perl 5.002.
+$VERSION is 1.0101.
 
 =cut
 
 require 5.000;
-use Config;
 use Carp;
+use File::Basename;
 require Exporter;
+
+use vars qw( $VERSION @ISA @EXPORT );
+$VERSION = "1.0101";
 @ISA = qw( Exporter );
 @EXPORT = qw( mkpath rmtree );
 
-sub mkpath{
+my $Is_VMS = $^O eq 'VMS';
+my $force_writeable = ($^O eq 'os2' || $^O eq 'msdos' || $^O eq 'MSWin32'
+		       || $^O eq 'amigaos');
+
+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
@@ -101,40 +111,58 @@ sub mkpath{
     $mode = 0777 unless defined($mode);
     $paths = [$paths] unless ref $paths;
     my(@created);
-    foreach $path (@$paths){
-	next if -d $path;
-        my(@p);
-        foreach(split(/\//, $path)){
-            push(@p, $_);
-            next if -d "@p/";
-            print "mkdir @p\n" if $verbose;
-	    mkdir("@p",$mode) || croak "mkdir @p: $!";
-            push(@created, "@p");
-        }
+    foreach $path (@$paths) {
+        next if -d $path;
+        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);
     }
     @created;
 }
 
 sub rmtree {
     my($roots, $verbose, $safe) = @_;
-    my(@files,$count);
+    my(@files);
+    my($count) = 0;
     $roots = [$roots] unless ref $roots;
 
     foreach $root (@{$roots}) {
        $root =~ s#/$##;
-       if (-d $root) { 
+       if (not -l $root and -d _) { 
            opendir(D,$root);
-           @files = map("$root/$_", grep $_!~/^\.{1,2}$/, readdir(D));
+           @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);
-           next if ($safe && !(-w $root));
+           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 { 
-           next if ($safe && !(-w $root));
+           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;
-           (unlink($root) && ++$count) or carp "Can't unlink file $root: $!";
+           while (-e $root || -l $root) { # delete all versions under VMS
+               (unlink($root) && ++$count)
+                   or croak "Can't unlink file $root: $!";
+           }
         }
     }