path: root/bin/checklinks

#!/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 $msglevel = 0;
my $remove = 0;
my %substitute;
my $linkfile;
my $exit = 0;

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

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

open(my $links, '<', $linkfile) or die("Can't open $linkfile: $!");
while (my $line = <$links>) {
	chomp($line);

	foreach my $key (keys(%substitute)) {
		$line =~ s/\$$key/$substitute{$key}/g;
	}

	my ($type, $src, $dst) = split(/\s+/, $line);

	next unless ($type eq 'soft' or $type eq 'hard');

	if ($remove) {
		remove_link($type, $src, $dst);
	}
	elsif ($type eq 'soft') {
		check_symlink($src, $dst);
	}
	elsif ($type eq 'hard') {
		check_hardlink($src, $dst);
	}
}
close($links);

sub remove_link {
	my ($type, $src, $dst) = @_;

	if (
	       ($type eq 'soft' and -l "$base/$src")
	    or ($type eq 'hard' and -e "$base/$src" and -e "$base/$dst")
	) {
		unlink("$base/$src") or warn("cannot unlink $base/$src: $!");
		print_format('removed', $src, '', 'red', 1);
	}
	return;
}

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);
	}
	return;
}

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);
	}
	return;
}

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 .= $_;
	}
	return;
}

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

	if ($level > 1) {
		$exit++;
	}

	return if ($level < $msglevel);

	if (defined($color)) {
		printf(colored('%-9s', $color), $message);
	}
	else {
		printf('%-9s', $message);
	}

	printf(" %-15s -> %-15s\n", $src, $dst);
	return;
}

exit($exit);

__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<-m>, B<--msglevel>=I<level>

Set the level threshold to show status messages.

   0  show everything
   1  filter "ok" and "absolute" messages
   2  filter everything but "EXISTS" and "no dst"
  >2  no messages

=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 ct(1), $package will be set to the current
package's relative path (as seen from $HOME, like C<packages/caretaker>),
and $etc will be set to $package/etc (like C<packages/caretaker/etc>)

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

Shortcut for C<< --msglevel=1 >>

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

Remove all link sources (hardlinks: only if their destination exists)

=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 (hard links only)

The link destination does not exist and therefore cannot be hardlinked to

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

The exit value is the number of files with grave errors
(a status of "exists" or "no dest").