5 use File::Basename; |
5 use File::Basename; |
6 use File::Spec::Functions qw(catfile rel2abs abs2rel canonpath); |
6 use File::Spec::Functions qw(catfile rel2abs abs2rel canonpath); |
7 use Sys::Hostname; |
7 use Sys::Hostname; |
8 use autodie; |
8 use autodie; |
9 use Getopt::Long; |
9 use Getopt::Long; |
|
10 use English qw(-no_match_vars); |
|
11 |
|
12 our $VERSION = '0.0'; |
10 |
13 |
11 my $opt_force = 0; |
14 my $opt_force = 0; |
12 |
15 |
13 GetOptions('f|force!' => \$opt_force) |
16 GetOptions('f|force!' => \$opt_force) |
14 or die "Usage: $0 [--force]\n"; |
17 or die "Usage: $PROGRAM_NAME [--force]\n"; |
15 |
18 |
16 # list of files/dirs to exclude |
19 # list of files/dirs to exclude |
17 my @exclude = map { qr/$_/ } qw( |
20 |
18 ^\.\.?$ |
21 my @exclude = map { qr/$_/xms } qw( |
19 ^\.hg$ |
22 ^\.\.?$ |
20 ), basename $0; |
23 ^\.hg$ |
|
24 ), basename $PROGRAM_NAME; |
21 |
25 |
22 ... if $opt_force; |
26 ... if $opt_force; |
23 |
27 |
24 foreach my $this (grep { not $_ ~~ @exclude } glob('.*')) { |
28 foreach my $this (grep { not $_ ~~ @exclude } glob q{.*}) { |
25 |
29 |
26 my $link = catfile $ENV{HOME}, $this; |
30 my $link = catfile $ENV{HOME}, $this; |
27 |
31 |
28 given ($link) { |
32 given ($link) { |
29 when (not -e) { |
33 when (not -e) { |
30 { no autodie; unlink $link } # may be necessary if it's a broken symlink |
34 { |
31 symlink abs2rel($this, $ENV{HOME}) => $link; |
35 no autodie; |
32 say "$link linked"; |
36 unlink $link |
33 next; |
37 } # may be necessary if it's a broken symlink |
34 } |
38 symlink abs2rel($this, $ENV{HOME}) => $link; |
35 when(not -l) { |
39 say "$link linked"; ## no critic |
36 warn "$link is not a link, skipping\n"; |
40 next; |
37 next; |
41 } |
38 } |
42 when (not -l) { |
39 when(-l) { |
43 warn "$link is not a link, skipping\n"; |
40 my $dst = rel2abs(readlink, $ENV{HOME}); |
44 next; |
41 next if $dst eq rel2abs($this); |
45 } |
42 warn "$link is a link to $dst, skipping\n"; |
46 when (-l) { |
43 next; |
47 my $dst = rel2abs(readlink, $ENV{HOME}); |
44 } |
48 next if $dst eq rel2abs($this); |
45 default { ... } |
49 warn "$link is a link to $dst, skipping\n"; |
|
50 next; |
|
51 } |
|
52 default { ... } |
46 } |
53 } |
47 } |
54 } |