| Subject: | Clean up temp directory on exit, even if current directory (patch included) |
It's quite tempting to do something like this:
use File::Temp qw(tempdir);
my $dir = tempdir(CLEANUP => 1);
chdir $dir or die;
# now do some work in the current directory
However, the directory isn't automatically cleaned up because you cannot
rmtree() the current directory. Recent releases of File::Temp and
File::Path give a warning about this, but wouldn't it be better for it
to just do the right thing?
This patch makes the directory be cleaned up on exit by doing chdir('/')
if necessary. That happens only for automatic cleanup at END - if you
manually call cleanup() in the middle of your program it is still your
responsibility to sort out the current directory.
| Subject: | File-Temp-0.21-cleanup_cwd.diff |
diff -ru File-Temp-0.21/Temp.pm File-Temp-0.21-new/Temp.pm
--- File-Temp-0.21/Temp.pm 2008-11-14 00:53:52.000000000 +0000
+++ File-Temp-0.21-new/Temp.pm 2009-04-23 13:20:33.000000000 +0100
@@ -868,12 +868,17 @@
# Set up an end block to use these arrays
END {
local($., $@, $!, $^E, $?);
- cleanup();
+ cleanup(at_exit => 1);
}
- # Cleanup function. Always triggered on END but can be invoked
- # manually.
+ # Cleanup function. Always triggered on END (with at_exit => 1) but
+ # can be invoked manually.
sub cleanup {
+ my %h = @_;
+ my $at_exit = delete $h{at_exit};
+ $at_exit = 0 if not defined $at_exit;
+ { my @k = sort keys %h; die "unrecognized parameters: @k" if @k }
+
if (!$KEEP_ALL) {
# Files
my @files = (exists $files_to_unlink{$$} ?
@@ -893,17 +898,36 @@
# Dirs
my @dirs = (exists $dirs_to_unlink{$$} ?
@{ $dirs_to_unlink{$$} } : () );
+ my ($cwd, $cwd_to_remove);
foreach my $dir (@dirs) {
if (-d $dir) {
# Some versions of rmtree will abort if you attempt to remove
- # the directory you are sitting in. We protect that and turn it
- # into a warning. We do this because this occurs during
- # cleanup and so can not be caught by the user.
+ # the directory you are sitting in. For automatic cleanup
+ # at program exit, we avoid this by chdir()ing out of the way
+ # first. If not at program exit, it's best not to mess with the
+ # current directory, so just let it fail with a warning.
+ if ($at_exit) {
+ $cwd = File::Spec->rel2abs(File::Spec->curdir) if not defined $cwd;
+ my $abs = File::Spec->rel2abs($dir);
+ if ($abs eq $cwd) {
+ $cwd_to_remove = $dir;
+ next;
+ }
+ }
eval { rmtree($dir, $DEBUG, 0); };
warn $@ if ($@ && $^W);
}
}
+ if (defined $cwd_to_remove) {
+ # We do need to clean up the current directory, and everything
+ # else is done, so get out of there and remove it.
+ my $root = File::Spec->rootdir;
+ chdir $root or die "cannot chdir to $root: $!";
+ eval { rmtree($cwd_to_remove, $DEBUG, 0); };
+ warn $@ if ($@ && $^W);
+ }
+
# clear the arrays
@{ $files_to_unlink{$$} } = ()
if exists $files_to_unlink{$$};
@@ -1149,9 +1173,12 @@
If the object has been passed to a child process during a fork, the
file will be deleted when the object goes out of scope in the parent.
-For a temporary directory object the directory will be removed
-unless the CLEANUP argument was used in the constructor (and set to
-false) or C<unlink_on_destroy> was modified after creation.
+For a temporary directory object the directory will be removed unless
+the CLEANUP argument was used in the constructor (and set to false) or
+C<unlink_on_destroy> was modified after creation. Note that if a temp
+directory is your current directory, it cannot be removed - a warning
+will be given in this case. C<chdir()> out of the directory before
+letting the object go out of scope.
If the global variable $KEEP_ALL is true, the file or directory
will not be removed.
@@ -2135,6 +2162,11 @@
that none of the temp files are required. This method can be registered as
an Apache callback.
+Note that if a temp directory is your current directory, it cannot be
+removed. C<chdir()> out of the directory first before calling
+C<cleanup()>. (For the cleanup at program exit when the CLEANUP flag
+is set, this happens automatically.)
+
On OSes where temp files are automatically removed when the temp file
is closed, calling this function will have no effect other than to remove
temporary directories (which may include temporary files).
diff -ru File-Temp-0.21/t/tempfile.t File-Temp-0.21-new/t/tempfile.t
--- File-Temp-0.21/t/tempfile.t 2008-09-07 01:06:02.000000000 +0100
+++ File-Temp-0.21-new/t/tempfile.t 2009-04-23 13:28:00.000000000 +0100
@@ -3,7 +3,7 @@
use strict;
use Test;
-BEGIN { plan tests => 22}
+BEGIN { plan tests => 24}
use File::Spec;
# Will need to check that all files were unlinked correctly
@@ -120,7 +120,7 @@
print "# TEMPFILE: Created $tempfile\n";
ok( -f $tempfile );
ok( close( $fh ) );
-push( @still_there, $tempfile); # check at END
+push( @still_there, File::Spec->rel2abs($tempfile) ); # check at END
# Would like to create a temp file and just retrieve the handle
# but the test is problematic since:
@@ -145,6 +145,15 @@
skip "Skip Failed probably due to NFS", 1;
}
+# Create temp directory and chdir to it; it should still be removed on exit.
+$tempdir = tempdir(CLEANUP => 1);
+
+print "# TEMPDIR: $tempdir\n";
+
+ok( (-d $tempdir) );
+chdir $tempdir or die $!;
+push(@dirs, $tempdir);
+
# Now END block will execute to test the removal of directories
print "# End of tests. Execute END blocks\n";