Find Symlink Targets

• Tweet
• 

        Find all the files in a tree that have symlinks pointing to them, list the files, each followed by a list of the symlinks that point to them.

#!/usr/bin/perl
#
#
# Find all the files that have a symlink pointing to them.
#
#
use warnings;
use strict;

use File::Find ();

my $libs_dir = shift;
die "Usage: $0 DIR_TO_SEARCH\n" if ! $libs_dir;
die "$0: Can't search '$libs_dir': $!\n" if ! -d $libs_dir;

# Set the variable $File::Find::dont_use_nlink if you're using AFS,
# since AFS cheats.

# for the convenience of &wanted calls, including -eval statements:
use vars qw/*name *dir *prune/;
*name   = *File::Find::name;
*dir    = *File::Find::dir;
*prune  = *File::Find::prune;

sub wanted;
sub doexec ($@);

my $keep;

use Cwd ();
my $cwd = Cwd::cwd();


# Traverse desired filesystems
File::Find::find({wanted => \&wanted}, $libs_dir);

# use Data::Dumper;
# print Dumper $keep;

for my $target ( sort keys %{$keep} ) {
    my $name = join (' ', @{$keep->{$target}});
    if ( -e $target ) {
        printf("%-60s ( %s )\n", $target, $name);
    }
    else {
        printf("DANGLING: %-60s ( %s )\n", $target, $name);
    }
}

exit;


sub wanted {
    my ($dev,$ino,$mode,$nlink,$uid,$gid);

    (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
    -l _ &&
    resolve_link(0, $name);
}


sub resolve_link ($@) {

    my ($ok, $name) = (shift, shift);

    chdir $cwd; #sigh
    my $target = readlink $name;
    die "Got no target for $name\n" if ! $target;
    chdir $File::Find::dir;
    if ( $target =~ m{^/} ) {

        # Absolute path

        if ( $target =~ m{\.\.} ) {

            die "FixMe: '$target'\n";

        }

    }
    elsif ( $target =~ m{^\.\./} ) {

        # Relative ../ path

        $target = "$dir/$target";
        while ( $target =~ m{/([^/]+)/\.\./} ) {

            $target =~ s{/$1/\.\./}{/}g;

        }

        if ( $target =~ m{\.\.} ) {

            die "FixMe: '$target'\n";

        }

    }
    elsif ( $target =~ m{^[^/]+} ) {

        # Relative path
        $target = "$dir/$target";

    }

    push @{$keep->{$target}}, $name;
    return !$?;

}

Tags:
• find
• Perl
• symlinks