#!/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 ($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("Can't open $linkfile: $!"); while() { 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'); } 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) = @_; 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 [ I ] =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=I While reading the links file, replace $I with I. When used in conjuction with pkg(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) =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. =head1 BUGS There are no checks whether the symlink target actually exists.