Why doesn't File::Find handle my dangling symlink?

Question

I'm using Perl's File::Find module to scan for files, directories, and links. Among other things, I want the utility I'm writing to report dangling links. In theory, this is supported by creating a subroutine to be called whenever an dangling link has been found, and calling the find method with a hash reference of appropriate values, such as:

my %options = (
   wanted            => \&ProcessFile,
   follow            => 1,
   follow_skip       => 2,
   dangling_symlinks => \&Dangling
);

find(\%options, @ARGV);

Despite deliberately creating a dangling link to test this, File::Find never, ever calls the subroutine "Dangling". Everything else works except this feature (i.e. the ProcessFile sub gets called as expected, links are followed, etc.. Anyone have andy experience with this?

Answer 1

Created test.pl in my home directory:

#!/usr/bin/perl

use File::Find;

my %options = ( wanted => \&ProcessFile,
                follow => 1,
                follow_skip => 2,
                dangling_symlinks => \&Dangling );

find(\%options, @ARGV);

sub ProcessFile {
  print "ProcessFile ($File::Find::name in $File::Find::dir)\n";
}

sub Dangling {
  my ($name, $dir) = @_;
  print "Dangling ($name in $dir)\n";
}

Then:

    $ chmod 755 test.pl

    $ mkdir /tmp/findtest
    $ cd /tmp/findtest
    $ ln -s /tmp/doesnotexist linkylink
    $ ~/test.pl .

Results in:

ProcessFile (. in .)
Dangling (linkylink in ./)
ProcessFile (./linkylink in .)

Answer 2

I like seeing File::Find::Rule in use, but it makes no difference here.

That being said,

$ mkdir test
$ cd test
$ ln -s a b
$ perl -w -MFile::Find -e'find({wanted=>sub{print"wanted $_\n"},dangling_symlinks=>sub{print"dangling $_[0] in $_\n"},follow=>1},".")'
wanted .
dangling b in .
wanted b

works for me.

What's perl -MFile::Find -e'print"$File::Find::VERSION\n"'?

update

Looking through Perl's RT, I found #28929: File::Find follow_fast => 1 loses dangling symlink. It apparently affects File::Find 1.07 and earlier, which is bundled with Perl 5.8.7 and earlier (as well as 5.9.1 and earlier in the 5.9.x development line).

I would suggest you convince your sysadmins to update Perl, or at least a few modules (and add File::Find::Rule while they're at it), but failing that, you can make your own $PERL5LIB and place updated modules there.

Answer 3

I did a quick test to work out what behaviors dangling symlinks exhibit, and it turns out the definition of a symlink is as far as I can make out

1. -l returns true
2. -e returns undef # because -e works on the linked file

So using File::Find::Rule what you appear to be trying to do is relatively simple:

#!/usr/bin/perl 

use strict;
use warnings;
use File::Find::Rule ();

my @files = File::Find::Rule->symlink->exec(sub{ !-e $_ })->in('/tmp/test');

print "$_,\n" for @files;

This code snippet was able to detect all my broken symlinks that I could tell.

If you want the Test I ran to conclude this:

#!/usr/bin/perl 

use strict;
use warnings;
use File::Path ();
use Carp       ();

my $testdir = "/tmp/test";

# Generating test

# Making Dirs
dirmk($_)
  for (
    qw(
    /realdir/
    /deleteddir/
    )
  );

#"Touching" some files
generate($_)
  for (
    qw(
    /realfile
    /deletedfile
    /realdir/realfile
    /realdir/deletedfile
    /deleteddir/afile
    )
  );

# Symlink them
{
    lns( '/realfile',            '/realfile_symlink' );
    lns( '/deletedfile',         '/deletedfile_symlink' );
    lns( '/realdir',             '/realdir_symlink' );
    lns( '/deleteddir',          '/deleteddir_symlink' );
    lns( '/realdir/realfile',    '/realdir_realfile_symlink' );
    lns( '/realdir/deletedfile', '/realdir_deletedfile_symlink' );
    lns( '/deleteddir/afile',    '/deleteddir_file' );
}

# Make the deletions
del($_)
  for (
    qw(
    /deletedfile
    /deleteddir/afile
    /realdir/deletedfile
    /deleteddir/
    )
  );

statify($_)
  for (
    '', qw(
    /realfile
    /realfile_symlink
    /deletedfile_symlink
    /realdir
    /realdir_symlink
    /deleteddir_symlink
    /realdir/realfile
    /realdir_realfile_symlink
    /realdir_deletedfile_symlink
    /deleteddir_file
    )
  );

sub statify {
    my $fn = $testdir . shift;
    printf(
        "r: %3s e: %3s s: %3s f: %3s d: %3s l: %3s | %s \n",
        -r $fn || 0,
        -e $fn || 0,
        -s $fn || 0,
        -f $fn || 0,
        -d $fn || 0,
        -l $fn || 0,
        $fn
    );

}

sub generate {
    my $fn = $testdir . shift;
    open my $fh, '>', $fn or Carp::croak("Error Creating $fn $! $@");
    print $fh "This is $fn \n";
    close $fh or Carp::carp("Error on close for $fn $! $@");
    return;
}

sub lns {
    my $x = $testdir . shift;
    my $y = $testdir . shift;
    if ( -e $y ) {
        unlink $y;
    }
    symlink $x, $y or Carp::croak("Error ln $x => $y , $! $@");
}

sub del {
    my $fn = $testdir . shift;
    if ( -f $fn ) {
        unlink $fn;
    }
    if ( -d $fn ) {
        rmdir $fn;
    }
}

sub dirmk {
    my $fn = $testdir . shift;
    File::Path::mkpath($fn);
}

And here was the output:

r:   1 e:   1 s: 220 f:   0 d:   1 l:   0 | /tmp/test 
r:   1 e:   1 s:  28 f:   1 d:   0 l:   0 | /tmp/test/realfile 
r:   1 e:   1 s:  28 f:   1 d:   0 l:   1 | /tmp/test/realfile_symlink 
r:   0 e:   0 s:   0 f:   0 d:   0 l:   1 | /tmp/test/deletedfile_symlink 
r:   1 e:   1 s:  60 f:   0 d:   1 l:   0 | /tmp/test/realdir 
r:   1 e:   1 s:  60 f:   0 d:   1 l:   1 | /tmp/test/realdir_symlink 
r:   0 e:   0 s:   0 f:   0 d:   0 l:   1 | /tmp/test/deleteddir_symlink 
r:   1 e:   1 s:  36 f:   1 d:   0 l:   0 | /tmp/test/realdir/realfile 
r:   1 e:   1 s:  36 f:   1 d:   0 l:   1 | /tmp/test/realdir_realfile_symlink 
r:   0 e:   0 s:   0 f:   0 d:   0 l:   1 | /tmp/test/realdir_deletedfile_symlink 
r:   0 e:   0 s:   0 f:   0 d:   0 l:   1 | /tmp/test/deleteddir_file