develooper Front page | perl.perl5.porters | Postings from March 2007

[PATCH] Allow rmtree (File::Path) option to keep subtree root

Thread Next
From:
Steve Brokenshire
Date:
March 6, 2007 05:06
Subject:
[PATCH] Allow rmtree (File::Path) option to keep subtree root
Message ID:
200703061253.32123.sbrokenshire@xestia.co.uk
Hi,

The patch below gives rmtree (File::Path) an argument to keep the subtree 
root. If the keep the subtree root boolean is set to TRUE and the verbose 
boolean is also TRUE it will write a message saying it's skipped removing the 
directory because it's a subtree root.

mkdir -p test{1,2,3}/test{1,2,3}
perl -e "use File::Path; rmtree(['test1','test2','test3'], 1, 1, 1);"
rmdir test1/test1
rmdir test1/test3
rmdir test1/test2
skipped test1 (subtree root)
rmdir test2/test1
rmdir test2/test3
rmdir test2/test2
skipped test2 (subtree root)
rmdir test3/test1
rmdir test3/test3
rmdir test3/test2
skipped test3 (subtree root)

Should the message be 'skipped (directory) (subtree root)' or 'skipped subtree 
root (directory)'?

Thanks,
Steve

--------------------

--- File/Path.pm	2007-03-05 20:31:05.000000000 +0000
+++ File/Path.pm	2007-03-06 10:48:34.000000000 +0000
@@ -9,7 +9,7 @@
     use File::Path;
 
     mkpath(['/foo/bar/baz', 'blurfl/quux'], 1, 0711);
-    rmtree(['foo/bar/baz', 'blurfl/quux'], 1, 1);
+    rmtree(['foo/bar/baz', 'blurfl/quux'], 1, 1, 1);
 
 =head1 DESCRIPTION
 
@@ -51,7 +51,7 @@
 
 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:
+C<rmtree> takes four arguments:
 
 =over 4
 
@@ -60,7 +60,8 @@
 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.
+will be deleted (unless the keep subtree root boolean is
+set to TRUE).
 
 =item *
 
@@ -79,6 +80,14 @@
 a criterion for 'delete permission' under OSs other
 than VMS is settled.  (defaults to FALSE)
 
+=item *
+
+a boolean value, which if TRUE will cause C<rmtree> to not 
+delete the subtree root(s) given. If the verbose boolean is
+set to TRUE then it will write a message saying it skipped
+removing the directory because it's a subtree root.
+(defaults to FALSE)
+
 =back
 
 It returns the number of files successfully deleted.  Symlinks are
@@ -113,8 +122,9 @@
 
 =head1 AUTHORS
 
-Tim Bunce <F<Tim.Bunce@ig.co.uk>> and
-Charles Bailey <F<bailey@newman.upenn.edu>>
+Tim Bunce <F<Tim.Bunce@ig.co.uk>>,
+Charles Bailey <F<bailey@newman.upenn.edu>> and
+Steve Brokenshire <F<sbrokenshire@xestia.co.uk>>
 
 =cut
 
@@ -125,7 +135,7 @@
 use strict;
 use warnings;
 
-our $VERSION = "1.08";
+our $VERSION = "1.09";
 our @ISA = qw( Exporter );
 our @EXPORT = qw( mkpath rmtree );
 
@@ -173,11 +183,12 @@
 }
 
 sub rmtree {
-    my($roots, $verbose, $safe) = @_;
+    my($roots, $verbose, $safe, $keeptop) = @_;
     my(@files);
     my($count) = 0;
     $verbose ||= 0;
     $safe ||= 0;
+    $keeptop ||= 0;
 
     if ( defined($roots) && length($roots) ) {
       $roots = [$roots] unless ref $roots;
@@ -230,7 +241,7 @@
 	    } else {
 		@files = map("$root/$_", grep $_!~/^\.{1,2}\z/s,@files);
 	    }
-	    $count += rmtree(\@files,$verbose,$safe);
+	    $count += rmtree(\@files,$verbose,$safe,0);
 	    if ($safe &&
 		($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
 		print "skipped $root\n" if $verbose;
@@ -239,15 +250,19 @@
 	    chmod $rp | 0700, $root
 	      or carp "Can't make directory $root writeable: $!"
 		if $force_writeable;
-	    print "rmdir $root\n" if $verbose;
-	    if (rmdir $root) {
-		++$count;
-	    }
-	    else {
-		carp "Can't remove directory $root: $!";
-		chmod($rp, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
-		    or carp("and can't restore permissions to "
-		            . sprintf("0%o",$rp) . "\n");
+
+	    if ($keeptop){
+		  print "skipped $root (subtree root)\n" if $verbose;
+	    } else {
+		  print "rmdir $root\n" if $verbose;
+		  if (rmdir $root) {
+		      ++$count;
+		  } else {
+		      carp "Can't remove directory $root: $!";
+		      chmod($rp, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
+			    or carp("and can't restore permissions to "
+				    . sprintf("0%o",$rp) . "\n");
+	      }
 	    }
 	}
 	else {

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About