#!/usr/bin/perl -w
#
# -----------------------------------------------------------------------------
#
# findlink -- find symlinks by what they point to
# Copyright (C) 2003, 2004 Fabian "zzznowman" Pietsch
# Licensed under GPLv2 or, at your option, any later version
#
# -----------------------------------------------------------------------------
#
# Version 0.1.3 (2004-02-05)
# Based on zzznowman's findbrokensymlinks 0.1.3
#
# ChangeLog:
#  o v0.1.3
#    - fixed endless loop when called without options
#    - added usage information: findlink -h
#  o v0.1.2
#    - fixed argument handling
#      most importantly, -target option's argument is now taken literally
#      (i.e., "-target -gcc-2.95.3" now works without "unknown option" error)
#

use strict;
use File::Find;


# options & arguments
#   directories to search, targets to search for, whether to print targets
my (@dirs, @targets, $opt_ptarget);

# scalars for statistical evaluation
#   (explicitly initialized to 0 in case they're never incremented,
#   which would otherwise lead to "Use of uninitialized value" when printing)
my ($stats_link, $stats_found) = (0, 0);


# fail: exit with exit code given; output error message
sub fail($$) {
	print(STDERR $_[1] . "\n");
	exit($_[0]);
}

# usage: print out usage information and exit
sub usage() {
	print(
"findlink v0.1.3 -- find symlinks by what they point to\
Copyright (C) 2003, 2004 Fabian \"zzznowman\" Pietsch\
\
Usage: $0 [DIRS] [-target TARGET [[-or] [-target TARGET] [...]]] [-printt]\
DIRS may be one or more directories to scan; defaults to \".\"\
TARGET is a regex specifying the location the links looked for point to\
-target, -or may be abbreviated to -t, -o\
If -printt is given, the link's target is printed after its name\n"
	  );
	exit(0);
}


# process arguments: the first containing a "-" marks end of directory list
push(@dirs, shift) while ($ARGV[0] && ($ARGV[0] !~ /^-/));
my $opt;
foreach (@ARGV) {
	# take -t(arget) option's argument literally
	if (defined($opt) && ($opt eq 't')) {
		push(@targets, $_);
		$opt = 0;
		next;
	}
	fail(3, "Internal software error.") if ($opt);

	# check for known options
	if (/^-t(?:arget)?$/)	{ fail(3, "ANDing targets not supported yet.")
				    if (defined($opt));
				  $opt = 't'; next }
	if (/^-o(r)?$/)		{ fail(3, "-or used out of place.")
				    unless (defined($opt));
				  $opt = undef; next }
	if (/^-printt$/)	{ $opt_ptarget = 1; next }
	if (/^-h$/)		{ usage() }
	if (/^-/)		{ fail(3, "Invalid option: $_") }

	# non-option, non-(option's argument) argument
	fail(3, "Invalid argument: $_");
}
fail(3, "Option's argument missing at end of arguments.") if ($opt);
@dirs    = ('.') unless (scalar(@dirs));
@targets = ('.') unless (scalar(@targets));

# search directories given as arguments (or the current directory, if none)
find(sub {
	# only consider symlinks
	return unless (-l);
	$stats_link++;

	# does symlink's target match one supplied on the command line?
	foreach my $target (@targets) {
		if (readlink() =~ /$target/) {
			$stats_found++;
			print("$File::Find::name\n");
			print('  to  ' . readlink() . "\n") if ($opt_ptarget);
			return;
		}
	}
  }, @dirs);

## output summary
#print("\n",
#      "summary:\t$stats_found/$stats_link symlinks found\n");

# set exit code appropriately
exit(0) if ($stats_found);	# findlink found symlinks
exit(1) if ($stats_link);	# no symlinks found that match any target
exit(2);			# no symlinks found at all