#!/usr/bin/env perl
## Copyright © 2008-2009 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 $msglevel = 0;
my $remove = 0;
my %substitute;
my $linkfile;

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

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

open(LINKS, '<', $linkfile) or die("Can't open $linkfile: $!");
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 -l "$base/$src" and not -e "$base/$src") {
		symlink($dst, "$base/$src");
		print_format('created', $src, $dst, 'cyan', 1);
	}
	elsif (-l "$base/$src" and readlink("$base/$src") eq $dst) {
		print_format('ok', $src, $dst, 'green', 0);
	}
	elsif (-l "$base/$src" and readlink("$base/$src") eq "$base/$dst") {
		print_format('absolute', $src, $dst, 'yellow', 0);
	}
	elsif (not -l "$base/$src" and -e "$base/$src") {
		print_format('EXISTS', $src, $dst, 'bold red', 2);
	}
	elsif (-l "$base/$src") {
		unlink("$base/$src");
		symlink($dst, "$base/$src");
		print_format('fixed', $src, $dst, 'cyan', 1);
	}
}

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

	mkdirs($src);
	if (not -e "$base/$dst") {
		print_format('no dest', $src, $dst, 'red bold', 2);
	}
	elsif (not -f "$base/$src") {
		link("$base/$dst", "$base/$src") or warn($!);
		print_format('created', $src, $dst, 'cyan', 1);
	}
	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', 1);
	}
	elsif ((stat("$base/$src"))[1] == (stat("$base/$dst"))[1]) {
		print_format('ok', $src, $dst, 'green', 0);
	}
}

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, $level) = @_;

	return if ($level < $msglevel);
	if (defined($color)) {
		printf(colored('%-9s', $color), $message);
	} else {
		printf('%-9s', $message);
	}
	printf(" %-15s -> %-15s\n", $src, $dst);
}

__END__

=head1 NAME

checklinks - create/update links

=head1 SYNOPSIS

B<checklinks> [ I<options> ]

=head1 DESCRIPTION

Create or update links based on a file

=head1 OPTIONS

=over

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

Quiet. Hide unchanged links

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

Remove all symlinks. Hardlinks will be left as they are.

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

While reading the links file, replace $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 (like C<packages/core/etc>)

=back

=head1 OUTPUT

Typical checklinks output might look like this:

  ok        .zshrc          -> packages/zsh/etc/rc
  ok        .zprofile       -> packages/zsh/etc/profile
  absolute  .zlogin         -> packages/zsh/etc/login
  created   .zlogout        -> packages/zsh/etc/logout
  ok        .zshenv         -> packages/zsh/etc/env

The first item is the status, the second the link source (as in, the link),
the third the link target.

The following status messages are possible:

=over

=item ok

The link exists and points to the right file

=item absolute (soft links only)

The link exists and points to the right file, however it is an absolute link

=item fixed (soft links only)

The link pointed to the wrong file and has been corrected

=item updated (hard links only)

The source existed, but was not identical to the target. It has been deleted
and replaced with a link to the target

=item created

The link did not exist and has been created

=item EXISTS (soft links only)

The source already exists, but is not a symlink

=item no dest

The link destination does not exist

=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.

=item the source

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

In symlink mode, the source will only be updated if it either does not exist or
already is a symlink. This should prevent accidental data loss.
Note that in hardlink mode, the source will I<always> be deleted unless it is
already the correct hardlink

=item the target

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

=back

Lines beginning with an invalid symlink type will be ignored.

Example:

  # checklinks --parameter etc=packages/zsh
  soft .zshrc $etc/rc
  soft .zprofile $etc/profile
  soft .zlogin $etc/login
  soft .zlogout $etc/logout
  soft .zshenv $etc/env

=head1 BUGS

There are no checks whether the symlink target actually exists.