CoderZone.org

Category: >> Perl Code >> Find Symlink Targets Bookmark and Share

<< lastnext >>

Snippet Name: Find Symlink Targets

Description: 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.

Comment: (none)

Author: CoderZone
Language: PERL
Highlight Mode: PERL
Last Modified: December 03rd, 2010

#!/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 !$?;
 
}
 
There haven't been any comments added for this snippet yet. You may add one if you like.  Add a comment 
© coderzone.org | users online: 6