122 lines
3.2 KiB
Perl
Executable File
122 lines
3.2 KiB
Perl
Executable File
#! /usr/local/bin/perl
|
|
|
|
eval "exec /usr/local/bin/perl -S $0 $*"
|
|
if $running_under_some_shell;
|
|
|
|
################################################################################
|
|
#
|
|
# File: cleanLinks <source tree>
|
|
# RCS: $XConsortium: cleanLinks /main/3 1995/10/30 13:43:35 rswiston $
|
|
# Author: Marc Ayotte Hewlett-Packard, OSSD-CV
|
|
# Created: Sun Jul 4 17:57:13 PDT 1993
|
|
# Language: perl
|
|
# Package: N/A
|
|
# Status: CDE distributed
|
|
#
|
|
# (c) Copyright 1993, Hewlett-Packard Company, all rights reserved.
|
|
#
|
|
# Usage: cleanLinks <directory>
|
|
#
|
|
# Description: This script removes symbolic links to nowhere in
|
|
# <directory>. It does not remove anything with RCS
|
|
# in its path.
|
|
#
|
|
################################################################################
|
|
if ($ARGV[0]) {
|
|
$TREE = $ARGV[0];
|
|
}
|
|
else {
|
|
die " USAGE CleanLinks <source directory>\n";
|
|
}
|
|
|
|
if (! chdir("$TREE")) {
|
|
die " ERROR -> Couldn't change directory to $TREE.\n";
|
|
}
|
|
|
|
#######################################################
|
|
# define local subroutines
|
|
#######################################################
|
|
sub dokill {
|
|
die "\n left on INTR \n";
|
|
exit 1;
|
|
}
|
|
########################################################
|
|
# Catch signals
|
|
########################################################
|
|
$SIG{'INT'} = 'dokill';
|
|
|
|
|
|
##############################
|
|
# get the symlinks in the tree
|
|
##############################
|
|
if (! open(FIND,"find . -type d ! -type l -print|")) {
|
|
print STDERR " ERROR failure in open used for find.\n";
|
|
die "You may have to contact your build administrator\n";
|
|
}
|
|
#
|
|
# don't buffer find output
|
|
#
|
|
$| = 1;
|
|
|
|
print "************ List of symlinks to nowhere removed **********\n";
|
|
|
|
|
|
##################################################################
|
|
# go through the directories and examine each symlink.
|
|
# resolve the symlink and, if the file at the end doesn't exist,
|
|
# remove the original symlink. Don't do anything that ends in RCS.
|
|
##################################################################
|
|
FILE:
|
|
while ($new = <FIND>) {
|
|
chop $new;
|
|
if (! opendir(THISDIR,"$new")) {
|
|
print STDERR " WARNING -> could not process directory $new\n";
|
|
next FILE;
|
|
}
|
|
else {
|
|
if (! chdir("$new")) {
|
|
print STDERR " WARNING -> could not change directory to $new\n";
|
|
next FILE;
|
|
}
|
|
}
|
|
# remove . from $new path for cuteness of output
|
|
$new =~ s%^\.%%;
|
|
|
|
@allfiles = grep(!/^\.\.?$/, readdir(THISDIR));
|
|
foreach $file (@allfiles) {
|
|
if (( -l $file) && ($file !~ m%RCS$%) && (! -d $file)) {
|
|
#
|
|
# resolve the link
|
|
#
|
|
$tmp1file = $file;
|
|
$counter = 0;
|
|
while (defined($tmp2file = readlink($tmp1file))) {
|
|
$tmp1file = $tmp2file;
|
|
#
|
|
# watch for cyclic symlinks
|
|
#
|
|
if ($counter++ == 10) {
|
|
last;
|
|
}
|
|
}
|
|
#
|
|
# if last piece in resolved chain is not a file
|
|
# it is a symlink to nowhere -> remove
|
|
#
|
|
if ( ! -e $tmp1file) { # remove link to nowhere
|
|
if (unlink("$file")) {
|
|
print "removing ${TREE}${new}/${file}\n";
|
|
}
|
|
else {
|
|
print STDERR " WARNING -> ${TREE}${new}/${file} -> could not remove\n";
|
|
print "$!\n";
|
|
}
|
|
}
|
|
}
|
|
}
|
|
closedir(THISDIR);
|
|
if (! chdir("$TREE")) {
|
|
die " ERROR -> Couldn't change directory to $TREE.\n";
|
|
}
|
|
}
|