#!/usr/bin/perl -w
#
# -----------------------------------------------------------------------------
#
# zzz4-fixrelsymlinks -- fix broken relative symlinks:
#   (\.\./)+			->	/sto/fabian/
#   ^/home/fabian/sto(rage)?/	->	/sto/fabian/
#   warn on "
# Copyright (C) 2003 Fabian "zzznowman" Pietsch
# Released under GPLv2 or, at your option, any later version
#
# -----------------------------------------------------------------------------
#

use strict;
use File::Find;
use POSIX qw(getcwd);

# 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_fix, $stats_warn, $stats_err) = (0, 0, 0, 0);

# set autoflush on STDOUT (prevents STDOUT/STDERR mixing when both piped to tee)
my $oldfh = select(STDERR); $| = 1; select($oldfh); undef $oldfh;

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

	# where does $link point to?
	my ($link, $to, $cwd) = ($_, readlink(), getcwd());
	my $ton = $to;

	# is symlink's target ambiguous in a known way?
	if (($ton =~ s#^(?:\.\./)+(?:sto(?:rage)?/|fabian/)?#/sto/fabian/#) ||
	    ($ton =~ s#^/home/fabian/sto(?:rage)?/#/sto/fabian/#)) {
		# will fixing the target yield a valid symlink?
		if (-e $ton) {
			print("redirecting symlink \"$cwd/$link\"\n",
			      "  from\t$to\n",
			      "  to\t$ton\n");

			# fix symlink
			unlink($link);
			symlink($ton, $link);
			$to = $ton;
			$stats_fix++;
		}

		# old target at least valid for owner?
		#   (as opposed to "from the web"/"for the web server")
		elsif (-e $to) {
			print(STDERR "WARNING: symlink \"$cwd/$link\"\n",
			      "  to\t$to\n",
			      "  contains ambiguous elements, but\n",
			      "  can't fix it to \"$ton\": file does not exist\n");
			$stats_warn++;
		}
	}

	# does symlink's target exist (now)?
	if (!-e $to) {
		print(STDERR "\n",
		      "***\n",
		      "ERROR: symlink \"$cwd/$link\"\n",
		      "  to\t$to\n",
		      "  is completely broken!\n",
		      "***\n",
		      "\n");
		$stats_err++;
	}
  }, scalar(@ARGV) ? @ARGV : '.');

# output summary (for easier error tracking)
print("\n",
      "summary:\t$stats_fix/$stats_link symlinks fixed\n",
      $stats_warn ? "\t\t$stats_warn warnings\n" : '',
      $stats_err  ? "\t\t$stats_err errors\n"    : '');

# set exit code appropriately
exit(2) if ($stats_err);
exit(1) if ($stats_warn);