#!/usr/bin/env perl
## Copyright (C) 2008 by Daniel Friesel <derf@derf.homelinux.org>
## License: WTFPL <http://sam.zoy.org/wtfpl>
use strict;
use warnings;
use Getopt::Long;
use Term::ANSIColor;

my $base = $ENV{HOME};
my ($type, $src, $dst);
my $quiet = 0;
my $remove = 0;
my %substitute;
my $linkfile;

if (-f '.links') {
	$linkfile = '.links';
} elsif (-f 'links') {
	$linkfile = 'links';
} else {
	exit(0);
}

GetOptions(
	'q|quiet'  => \$quiet,
	'r|remove' => \$remove,
	'p|parameter=s' => \%substitute,
);

open(LINKS, '<', $linkfile) or die($!);
while(<LINKS>) {
	chomp;
	foreach my $key (keys(%substitute)) {
		s/\$$key/$substitute{$key}/g;
	}
	($type, $src, $dst) = split;
	next unless ($type eq 'soft' or $type eq 'hard');
	if ($remove) {
		remove_link($src);
	} elsif ($type eq 'soft') {
		check_symlink($src, $dst);
	} elsif ($type eq 'hard') {
		check_hardlink($src, $dst);
	}
}
close(LINKS);

sub remove_link {
	my $link = shift;

	if (-l "$base/$link") {
		unlink("$base/$link") or warn("cannot unlink $base/$link: $!");
		print_format('removed', $link, '', 'red');
	}
}

sub check_symlink {
	my $src = shift;
	my $dst = shift;

	mkdirs($src);
	#if (not -e "$base/$dst") {
	#	print_format('no dst!!', $src, $dst, 'red bold');
	#}
	if (not -l "$base/$src" and not -e "$base/$src") {
		symlink($dst, "$base/$src");
		print_format('created', $src, $dst, 'cyan');
	}
	elsif (readlink("$base/$src") eq $dst) {
		print_format('ok', $src, $dst, 'green') unless $quiet;
	}
	elsif (readlink("$base/$src") eq "$base/$dst") {
		print_format('absolute', $src, $dst, 'yellow') unless $quiet;
	}
	elsif (not -l "$base/$src" and -e "$base/$src") {
		print colored ("$base/$src: File exists but is not a symlink. Not updating.\n", 'bold red');
	}
	elsif (-l "$base/$src") {
		unlink("$base/$src");
		symlink($dst, "$base/$src");
		print_format('fixed', $src, $dst, 'cyan');
	}
}

sub check_hardlink {
	my $src = shift;
	my $dst = shift;

	mkdirs($src);
	if (not -e "$base/$dst") {
		print_format('no dst!!', $src, $dst, 'red bold');
	}
	elsif (not -f "$base/$src") {
		link("$base/$dst", "$base/$src") or warn($!);
		print_format('created', $src, $dst, 'cyan');
	}
	elsif ((stat("$base/$src"))[1] != (stat("$base/$dst"))[1]) {
		unlink("$base/$src");
		link("$base/$dst", "$base/$src") or warn($!);
		print_format('updated', $src, $dst, 'cyan');
	}
	elsif ((stat("$base/$src"))[1] == (stat("$base/$dst"))[1]) {
		print_format('ok', $src, $dst, 'green') unless $quiet;
	}
}

sub mkdirs {
	my $source = shift;
	my $path = $base;
	my @dirs = split(/\//, $source);

	# the last element is the file
	pop(@dirs);
	foreach(@dirs) {
		unless(-d "$path/$_") {
			mkdir("$path/$_") or die("Can't create $path/$_: $!");
		}
		$path .= $_;
	}
}

sub print_format {
	my ($message, $src, $dst, $color) = @_;

	$message .= ' 'x(9-length($message));
	$src .= ' 'x(15-length($src));
	$dst .= ' 'x(15-length($dst));
	if (defined($color)) {
		print colored ($message, $color);
	} else {
		print $message;
	}
	print "$src -> $dst\n";
}

__END__

=head1 NAME

checklinks - create/update symlinks

=head1 SYNOPSIS

B<checklinks> [ I<options> ]

=head1 DESCRIPTION

Create or update symlinks based on a file

=head1 OPTIONS

=over

=item B<-q>, B<--quiet>

quiet. Hide unchanged symlinks

=item B<-r>, B<--remove>

remove all symlinks

=item B<-p>, B<--parameter> I<parameter>=I<value>

While reading the links file, eplace $I<parameter> with I<value>.
When used in conjuction with pkg(1), $package will be set to the current
package's relative path (as seen from $HOME, like C<packages/core>),
and $etc will be set to $package/etc .

=back

=head1 FILES

The symlink definitions are read from the file F<.links> or F<links> in the
current working directory. Each line contains, separated by spaces:

=over

=item the symlink type

This may be one of 'soft' or 'hard', indicating either a symlink or a hardlink.
Note: The use of hardlinks is discouraged and not documented. The following
definitions only apply to symlinks. For hardlinks, may the source be with you.

=item the source

path of the source, i.e. the symlink. Relative to $HOME

=item the target

path of the target, i.e. the symlink's destination.
This is relativ to the source. See L<path_resolution>(7)

=back

Lines beginning with an invalid symlink type will be ignored.

=head1 BUGS

There are no checks whether the symlink target actually exists