#!/usr/bin/perl

########################################################################
# 
# slinky.pl -- a symbolic link walker
# 
# For each file name on the command line, this script will resolve
# all symbolic links in the path.  If -v (verbose) option, each step
# of the symlink resolution will be displayed.  Uses splice statement.
# 
# outline of program (for a single path):
# 
# split the path into array @path
# set initial $offset to 1
# loop: while (not too many links) {
#      join the first [0..$offset] components into $path
#      if ($path is a link) {
#              read the link into $link
#              if ($link is absolute) {
#                      splice $link into start of @path
#                      set $offset to 1 (re-start at beginning of path)
#              } else {
#                      splice $link into middle of @path
#              }
#      } elsif ($path exists) {
#              increment $offset
#      } else {
#              set $notexist flag and break out of loop
#      }
# }
#
########################################################################


# setup program path and name, and usage strings
@prog = split(/\//, $0);
$prog = $prog[$#prog];
$ustr = "usage: $prog [-Uv] file...\n";
$Ustr =<<EOF;
where
       -v      verbose (show each step of symlink resolution)
       -U      usage (show this message)
EOF

sub usage {
       print STDERR $ustr;
       print STDERR $Ustr if $_[0];
       exit 1;
}

while ($_ = $ARGV[0], /^-/) {
       shift;
       if ($_ eq '--') { last; }
       if (/v/)        { $verbose++; next; }
       if (/U/)        { &usage(1); }
       &usage();
}

&usage() if $#ARGV < 0;

$maxlinks = 32;
while ($#ARGV >= 0) {
       $_ = shift;
       s!^!./! unless m!^\.{0,2}/!;    # relative pathname: start with "./"
       print "$_:\n" if $verbose;
       @path = split(/\//, $_);
       $notexist = 0;
       $offset = 1;
       for ($nlinks=0; $nlinks<$maxlinks; ) {
               last if $offset > $#path;               # done???
               $path = join('/', @path[0..$offset]);   # get path head
               if ( -l $path ) {                       # it's a link:
                       $nlinks++;
                       printf "%5d:\t", $nlinks if $verbose;
                       &printit($offset-1, $offset) if $verbose;
                       print " -> " if $verbose;
                       $link = readlink($path);        # get the link
                       @tmp = split(/\//, $link);
                       if ($link =~ m!^/!) {
                               # link is absolute: replace @path head
                               splice(@path,0,$offset+1,@tmp);
                               &printit(0,$#tmp,1) if $verbose;
                               $offset = 1;            # and start at top
                       } else {
                               # link is relative: replace @path middle
                               splice(@path,$offset,1,@tmp);
                               &printit($offset-1,$offset+$#tmp) if $verbose;
                       }
                       print "\n" if $verbose;
               } elsif ( -e $path ) {          # not a link
                       $offset++;              # do next component of @path
               } else {
                       $notexist = 1;          # does not exist
                       last;
               }
       }
       if ($nlinks >= $maxlinks) {
               die "tracelinks: too many links, aborted";
       }
       print "$_";
       print " -> ", join('/',@path) if $nlinks;
       print " (does not exist)" if $notexist;
       print "\n";
       print "\n" if $verbose;
}

sub printit {
       local($d1,$d2,$abs) = @_;
       if ($abs) {
               print "{/";
       } else {
               print join('/', @path[0..$d1]);
               print "/{";
       }
       print join('/', @path[$d1+1..$d2]), "}";
       print "/", join('/', @path[$d2+1..$#path]) if $d2 < $#path;
}