Why doesn't File::Find handle my broken 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 broken (dangling in File::Find's parlance) symbolic links. In theory, this is supported by creating a subroutine to be called whenever a broken 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 broken 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.

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