#!/usr/bin/perl -w

#written: 20050129
#status : seems to work

$help[0] = "rmdanglinks - remove dangling symlinks                                ";
$help[1] = "syntax: rmdanglinks [-r] [-v] <directoryname>                         ";
$help[2] = "option -r makes it recurse over subdirectories.                       ";
$help[3] = "option -v makes it verbose (for debugging rmdanglink).                ";
$help[4] = "if -r is used and a directory contains a symlink to another directory,";
$help[5] = "  then this symlink is not followed.                                  ";

# utils :

sub ph { foreach $help (@help) { print("$help\n"); } }
sub es { print("Error: ",@_,"\n  $!\n"); }
sub v  { my( $msg ); if( $verbose ){ foreach $msg (@_) { print($msg, "\n"); } } }

# get arguments :

$verbose = 0 ; $recurse = 0 ;
foreach $arg (@ARGV) {
  if(    $arg eq "-v" ){ $verbose = 1 ; }
  elsif( $arg eq "-r" ){ $recurse = 1 ; }
  elsif( -d $arg      ){ $dirname = $arg ; }
  else                 { print("syntaxerror: unrecognized argument $arg\n");
			 ph(); exit(0); }
  }
unless( defined( $dirname )){
   print("syntaxerror: no directoryname specified\n"); ph(); exit(0); }

# subs :

sub checksymlink { my( $name, $target );
  $name = $_[0] ;
  $target = readlink( $name );
  if( -e $target ){ v("non-dangling $name->$target"); }
  else {
    if(0== system("rm $name") ){ v("removed dangling $name->$target"); }
    else                    { es("couldn't remove $name->$target"); }
    }
  }

sub dodir { my( $dir, @lines, $fullname );
  $dir = $_[0] ;
  unless( opendir(DIRH, $dir) ){ es("cant read $dir"); return ; }
  $/="\n"; @lines = readdir(DIRH);  closedir( DIRH );
  if( @lines ){ v("read $dir"); }
  else        { es("can't read from $dir"); return ; }

  foreach $line (@lines) {
    if( $line eq "." ){ next ; }
    if( $line eq ".."){ next ; }
    $fullname = $dir . "/" . $line ;
    if( -l $fullname ){ checksymlink( $fullname ); next ; }
    unless( $recurse ){ next ; }
    if( -d $fullname ){ dodir(        $fullname ); next ; }
    }
  }

# main :

if( substr( $dirname, 0, 1 ) eq "/" ){ $fulldirname = $dirname ; }
else { $pwd = `/bin/pwd` ; chomp( $pwd ); $fulldirname = $pwd . "/" . $dirname ; }

dodir( $fulldirname );
