#!/opt/perl/bin/perl -w
$vernum = "1.0 - 04 MAR 99" ;           # Code version and modify date
#
# Look for symbolic links 
#  findlink.pl [-R] dirname
#
# This code copyright 1999 by
# D. W. Eaton, Artronic Development, Phoenix, AZ -- dwe@arde.com
#
# This software is made freely available under the provisions of the Perl
# "Artistic" license:  http://language.perl.com/misc/Artistic.html
#
# This code is not supported and is not warranteed to perform any particular
# function. Contact dwe@arde.com for aditional information.
# If you find bugs or make enhancements, it would be appreciated if you
# sent them on to the author at dwe@arde.com.
#
# Bring in some useful library scripts
use FileHandle;
use Cwd;
use vars ('$vernum');

#
# Constants
$true  = 1;
$false = 0;
$badchr = "?"; # Bad link indicator

# Configuration
$debug = $false; # Print debug messages if true
#$debug = $true; # Print debug messages if true

# Initialize
$foundent = $false;
$foundbadent = $false;

# Useful things for this script to know
chomp ($hostname = `hostname`);
$hostname = 'localhost' unless $hostname;

print "Looking for symbolic links on $hostname\n";

#
# Check if we have any args
$option = "";
if (defined (@ARGV) && scalar (@ARGV) > 0)
{
 if ($ARGV[0] =~ /^-/)
 {
  $option = $ARGV[0];
  shift(@ARGV);
 }
}
if (! defined (@ARGV) || scalar (@ARGV) <= 0)
{
   die "\n\nSyntax:\n\n   $0  [-R] directoryname  ...\n\n";
}

if ($option && $option ne "-R")
{
 print "Option '$option' unknown, ignored.\n";
}
#
# Check the identity for given hosts
foreach $directory (@ARGV)
{
   if ($option eq "-R")
   {
    print "Under $directory";
   }
   else
   {
    print "Directory $directory";
   }
   if ($directory eq "." || $directory =~ /^.\//)
   {
    $cwd = cwd();
    print " (cwd = $cwd)";
   }
   print ":\n";
   &query_dir ($directory, $option);
}

if ($foundbadent)
{
 print "\nLinks pointing to non-existent destinations are";
 print " followed by $badchr\n";
}


exit (0);


#
# Move to the directory named and list it's contents
# If option is "-R", recurse through directories found
#  &query_dir (dirname, option)
sub query_dir
{
   my ($dirname,$option) = @_;
   my ($content,@allfiles);
   my ($entry,$realentry,$destination,$realdestination);

   $content = "";
   return undef unless $dirname && (-d $dirname);  # fail if no directory
   if (! opendir NXTDIR, $dirname)
   {
    print "No such directory: '$dirname'\n";
   }
   else
   {
    @allfiles = readdir NXTDIR;
    closedir NXTDIR;

    if ($debug) {print "Processing $dirname ...\n";}
    foreach $entry (@allfiles)
    {
     if ($debug) {print " Found $entry ...\n";}
     $realentry = $entry;
     if ($realentry !~ /^\//)
     {
      $realentry = $dirname;
      if ($dirname !~ /\/$/)
      {
       $realentry .= "/";
      }
      $realentry .= $entry;
     }
     if (-l $realentry)
     {
      $destination = readlink ($realentry);
      $realdestination = $destination;
      if ($realdestination !~ /^\//)
      {
       $realdestination = $dirname;
       if ($dirname !~ /\/$/)
       {
        $realdestination .= "/";
       }
       $realdestination .= $destination;
      }
      if ($debug) {print "  Found link $entry to $destination ... check $realdestination\n";}
      if (!-e $realdestination)
      {
       $destination .= " $badchr";
       $foundbadent = $true;
      }
      print "$realentry -> $destination\n";
      $foundent = $true;
     }
     elsif (-d $realentry && $option eq "-R")
     {
      if ($debug) {print "Looking into $realentry now ...\n";}
      if ($realentry !~ /\/.$/ && $realentry !~ /\/..$/)
      {
       # OK, not going to get caught looping on self ...
       &query_dir ($realentry, $option);
      }
      else
      {
       if ($debug) {print "Skipping $realentry\n";}
      }
     }
    }
   }
   return $content;
}
