[comp.unix.questions] 'counthops' Perl tool

merlyn@iwarp.intel.com (Randal Schwartz) (09/06/89)

In article <650005@grlab.UUCP>, scott@grlab (Scott Blachowicz) writes:
| Does anyone have a script to check for circular symbolic links? I had
| some lately that I noticed things like /foo/bar/bar -> /foo/bar. I think
| they got created by a script I had to go fix some of the symbolic links
| on the system (the script probably got a little over ambitious).

Well, although not exactly what you asked for (but it *is* close...)
I have this tool (in Perl, of course :-) that takes a list of paths
and computes the "hop count" -- an integer that represents the expense
of parsing such an address.  Although it would not specifically flag a
loop, you could run it in verbose mode (-v switch), and see if the
evaluation runs endlessly (anything the kernel can do, this can do
too! :-).

This was written before the Perl 3.0 beta, and was the reason that the
'readlink' function was added.  If you have Perl 3.0 beta, you can
probably replace all "do readlink" with "readlink".

================================================== cut here
#!/usr/bin/perl

# Usage: counthops [-v] f1 ...; or find ... | counthops [-v]
# Prints number of "hops" to lookup the file, coded as sym*1000+dir,
# where sym is the number of symbolic links, and dir is the number
# of directory entries.  -v says to be noisy about it.

$zero = $0;
$| = 1;

$onedir = 1;
$onesym = 1000;

$verbose = 0;

$pwd=`/bin/pwd`; chop($pwd);

sub readlink
{
	local($a) = shift @_;
	local($b) = `/bin/ls -ld $a`;
	local($c) = "";
	($c) = ($b =~ /-> (.*)/);
	$c || die "cannot use '/bin/ls -ld' to readlink...";
}

sub hops
{
	local($a) = shift @_;
	local($b,$c);
	print "## computing hops of $a\n" if $verbose;

	return 0 if $a eq "";
	$a = "$pwd/$a" unless $a =~ /^\//;
	return $b if $b = $hops{$a};
	if (-l $a) {
		$b = do readlink($a);
		($c = $a) =~ s/(.*)\/.*/\1/;
		if ($b =~ /^\//) {
			print "## $a => $c + $b\n" if $verbose;
			$hops{$a} = $onesym + $onedir + do hops($c) + do hops($b);
		} else {
			print "## $a => $c/$b\n" if $verbose;
			$hops{$a} = $onesym + $onedir + do hops("$c/$b");
		}
	} else {
		($b = $a) =~ s/(.*)\/.*/\1/;
		$hops{$a} = $onedir + do hops($b);
	}
}

$verbose = 1, shift if $ARGV[0] =~ /^-v/;

if ($#ARGV >= 0) {
	while ($_ = shift) {
		printf "%d\t%s\n", do hops($_), $_;
	}
} else {
	while (<>) {
		chop;
		printf "%d\t%s\n", do hops($_), $_;
	}
}
================================================== cut here

Just another Perl hacker,
-- 
/== Randal L. Schwartz, Stonehenge Consulting Services (503)777-0095 ====\
| on contract to Intel, Hillsboro, Oregon, USA                           |
| merlyn@iwarp.intel.com ...!uunet!iwarp.intel.com!merlyn	         |
\== Cute Quote: "Welcome to Oregon... Home of the California Raisins!" ==/