#!/usr/bin/perl -w
#
# -----------------------------------------------------------------------------
#
# zzz4-fixrelsymlinks -- fix broken relative symlinks:
#   ^(\.\./)+(sto(rage)?/|fabian/)?	->	/sto/fabian/
#   ^/home/fabian/sto(rage)?/		->	/sto/fabian/
#   warnning if "fixing" the link would break it
#   error if link neither is fixable nor points to an existing target
# Copyright (C) 2003 Fabian "zzznowman" Pietsch
# Licensed under GPLv2 or, at your option, any later version
#
# -----------------------------------------------------------------------------
#
# Version 0.1.3 (2003-12-12)
#

use strict;
use File::Find;

# 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 unless (-l);
	$stats_link++;

	# where does $link point to?
	my ($link, $to, $linkfull) = ($_, readlink(), $File::Find::name);
	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 to a valid symlink?
		if (-e $ton) {
			print("redirecting symlink \"$linkfull\"\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 \"$linkfull\"\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)?
	unless (-e $to) {
		print(STDERR "\n",
		      "***\n",
		      "ERROR: symlink \"$linkfull\"\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);