#!/usr/bin/env perl ## Copyright © 2008-2009 by Daniel Friesel ## License: 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 [ I ] =head1 DESCRIPTION Create or update links based on a file =head1 OPTIONS =over =item B<-m>, B<--msglevel>=I 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=I While reading the links file, replace $I with I. When used in conjuction with ct(1), $package will be set to the current package's relative path (as seen from $HOME, like C), and $etc will be set to $package/etc (like C) =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 The link destination does not exist =back =head1 FILES The symlink definitions are read from the file F<.links> or F 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 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(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 dst"). =head1 BUGS There are no checks whether the symlink target actually exists.