Bug #27233 for File-Remove: symlinks not removed if pointing to nonexisting destination

Here is an updated patch on top of version 0.36. It fixes the original issue, but may not be the perfect solution wrt. checking for can_delete. For a symbolic link, the criteria whether it can be removed, seems to be exclusively related to the write permission on the parent directory, and the presence of the "sticky bit" (= chmod +t): only if the current user has write permission to the directory, AND there is no sticky bit on the directory (or the user is the directory owner), then a symbolic link in the directory can be deleted. This is all on UNIX - no idea about other platforms. HTH, Marek

diff -ruN File-Remove-0.36/lib/File/Remove.pm File-Remove-0.36p1/lib/File/Remove.pm --- File-Remove-0.36/lib/File/Remove.pm 2007-06-29 04:54:36.000000000 +0200 +++ File-Remove-0.36p1/lib/File/Remove.pm 2007-07-02 10:25:10.000000000 +0200 @@ -3,7 +3,7 @@ use strict; use vars qw(@EXPORT_OK @ISA $VERSION $debug $unlink $rmdir); BEGIN { - $VERSION = '0.36'; + $VERSION = '0.36_01'; @ISA = qw(Exporter); @EXPORT_OK = qw(remove rm trash); # nothing by default :) @@ -52,6 +52,16 @@ # Iterate over the files my @removes; foreach my $path ( @files ) { + # need to check for symlink first + # could be pointing to nonexisting/non-readable destination + if ( -l $path ) { + print "link: $path\n" if $debug; + if ( $unlink ? $unlink->($path) : unlink($path) ) { + push @removes, $path; + } + next; + } + unless ( -e $path ) { print "missing: $path\n" if DEBUG; push @removes, $path; # Say we deleted it @@ -81,7 +91,7 @@ next; } - if ( -f $path or -l $path ) { + if ( -f $path ) { print "file: $path\n" if DEBUG; unless ( -w $path ) { # Make the file writable (implementation from File::Path) diff -ruN File-Remove-0.36/MANIFEST File-Remove-0.36p1/MANIFEST --- File-Remove-0.36/MANIFEST 2007-06-29 04:54:38.000000000 +0200 +++ File-Remove-0.36p1/MANIFEST 2007-07-02 10:28:08.000000000 +0200 @@ -8,5 +8,6 @@ t/02_directories.t t/03_deep_readonly.t t/04_can_delete.t +t/05_links.t t/99_author.t META.yml Module meta-data (added by MakeMaker) diff -ruN File-Remove-0.36/t/05_links.t File-Remove-0.36p1/t/05_links.t --- File-Remove-0.36/t/05_links.t 1970-01-01 01:00:00.000000000 +0100 +++ File-Remove-0.36p1/t/05_links.t 2007-07-02 10:20:45.000000000 +0200 @@ -0,0 +1,61 @@ +#!/usr/bin/perl + +use strict; +BEGIN { + $| = 1; + $^W = 1; +} + +use Test::More qw(no_plan); # tests => 3; +BEGIN { + use_ok('File::Remove' => qw(remove trash)) +}; + +unless(eval { symlink("",""); 1 }) { + diag("system cannot do symlinks"); + exit 0; +} + +# Set up the tests + +my $testdir = "linktest"; +if(-d $testdir) { + BAIL_OUT("Directory '$testdir' exists - please remove it manually"); +} +unless(mkdir($testdir, 0777)) { + BAIL_OUT("Cannot create test directory '$testdir': $!"); +} +my %links = ( + l_ex => '.', + l_ex_a => '/', + l_nex => 'does_not_exist' +); +my $errs = 0; +foreach my $link (keys %links) { + unless(symlink($links{$link}, "$testdir/$link")) { + diag("Cannot create symlink $link -> $links{$link}: $!"); + $errs++; + } +} +if($errs) { + BAIL_OUT("Could not create test links"); +} + +ok( remove(\1, map { "$testdir/$_" } keys %links), "remove \\1: all links" ); + +my @entries; + +ok(opendir(DIR, $testdir)); +foreach(readdir(DIR)) { + next if(/^\.\.?$/); + push(@entries, $_); +} +ok(closedir(DIR)); + +ok(@entries == 0, "no links remained in directory; found @entries"); + +ok( remove(\1, $testdir), "remove \\1: $testdir" ); + +ok( !-e $testdir, "!-e: $testdir" ); + +1;