!/usr/bin/perl

=head1 NAME

trace-symlinks -- locate symlinks and their targets

=head1 SYNOPSIS

trace-symlinks [-i] [-a] [path ...]

  default: search ".", list each link name and target on one line
  -i  : list all intermediate links on separate (indented) lines
  -a  : always show absolute path(s) of link target(s)

=head1 DESCRIPTION

This tool uses the standard unix "find" utility to locate all symbolic
links (symlinks) contained under one or more starting paths.  If no
explicit paths are given on the command line, the current working
directory is searched.  For each symlink found, we determine the
target file that it points to; if target itself is a symlink, we
continue until we find either an actual file (data or directory), or a
stale (non-existant/unreachable) target.

The default output lists the initial symlinks and their ultimate
targets together on one line, separated by " -> "; the comment "###
bad link" is appended at the end of the line if the final target was
stale.  For simple, single-stage link targets, the target is listed as
defined in the symlink (i.e. it may be a relative or absolute path);
but for multi-stage links, the single-line output will show the
absolute path of the final target, along with a comment at the end
showing how many intermediate links were involved.

The "-a" option will cause all link targets to be listed as absolute
paths.

With the "-i" option, each intermediate link will be listed on a
separate line.

=head1 AUTHOR

David Graff, University of Pennsylvania

=cut

require 5.008;

use strict;
use Cwd qw/abs_path/;
use File::Basename qw/fileparse/;
use Getopt::Std;

my $Usage = "\nUsage: $0 [-a] [-i] [path ...]\n".
    "  default: list link name and target file on one line\n".
    "  -a -- always show absolute path(s) of link target(s)\n".
    "  -i -- include all intermediate links on separate lines\n";

my %opt;
getopts( 'ail', \%opt ) || die $Usage;

my @paths;
my $errs;
my $find = '/usr/bin/find';

for ( @ARGV ) {
    s{ /$ }{}x;
    if ( -d ) {  # note: a link to a dir will pass as well
        push @paths, $_;
    } else {
        warn "Command line arg '$_' is not a directory -- skipped\n";
        $errs++;
    }
}
if ( @paths == 0 ) {
    die $Usage if ( $errs );
    push( @paths, '.' );
}

my $errbase = "/tmp/$ENV{USER}.symtrace.$$.";
my $iter = 0;

foreach my $path ( @paths ) 
{
    my $truepath = abs_path( $path );
    if ( $path ne '.' ) {
        $truepath =~ s{ /$path$ }{}x;
    }
    my @list = ();
    my $errfile = $errbase . ++$iter;
    {
        local $/ = chr(0);
        open( FIND, "$find $path -type l -print0 2>$errfile |" )
            or die "$path : can't run find";
        @list = <FIND>;
        chomp @list;
        close FIND;
    }

    if ( -s $errfile ) {
        warn "$path (== $truepath): errors reported by $find; see $errfile\n";
    } else {
        unlink "$errfile";
    }

    if ( @list == 0 ) {
        warn "$path (== $truepath): no symlinks found\n";
        next;
    }
    print "\n# SYMLINK LIST FOR $path (== $truepath/$path):\n";
    foreach my $link ( @list )
    {
        print $link;
        while ( -l $link ) {
            my ( $target, $nxtlink ) = get_target( $link );
            unless ( $target and $nxtlink ) {
                print " -> $target ### bad link\n";
                last;
            }
            my $showtarg = $target;
            if ( $opt{i} and -l $nxtlink ) {
                print " -> $nxtlink\n";
            }
            else {
                if ( $opt{a} ) {
                    $showtarg = ( $nxtlink =~ m{^/} ) ?  abs_path ( $nxtlink ) :
                        abs_path( "$truepath/$nxtlink" );
                    $showtarg .= ' (' . $target . ')' if ( $showtarg ne $target );
                }
                print " -> $showtarg\n" if ( $opt{i} or -l $nxtlink );
            }
            $link = $nxtlink
        }
    }
}

sub get_target
{
    my $lnk = shift;
    my $targ = readlink( $lnk );
    unless ( $targ ) {
        warn "$targ : readlink failed, $!\n";
        return;
    }
    my $found = undef;
    if ( $targ =~ m{^/} ) {
        $found = $targ if ( -e $targ );
    } else {
        my ( $lnkname, $lnkpath ) = fileparse( $lnk );
        $found = "$lnkpath$targ" if ( -e "$lnkpath$targ" );
    }
    return ( $targ, $found );
}