1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
#!/usr/bin/perl -w
# Copyright (C) 2020-2021 Miquel Sabaté Solà <mikisabate@gmail.com>
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
# This file will call `find` for the given directory (or $HOME if no argument
# was given), and it will print to stdout broken symlinks.
#
# That being said, there are a bunch of applications that may have some symlinks
# broken (hopefully expected?). For those cases you can add a file called
# `.find-broken-symlinks-ignore.txt` in your $HOME directory, which contains
# multiple lines of patterns to be ignored. These patterns can be Perl regexpes,
# this script will swallow everything without even checking (so don't be stupid).
#
# The exit code will be 1 if there are broken symlinks, and 0 if everything is
# good.
use File::Spec::Functions 'catfile';
use IO::Select;
use strict;
##
# The path can be given, otherwise we will pick $HOME as the default.
my $path = $ENV{'HOME'};
if ($#ARGV >= 1) {
$path = $ARGV[0];
} elsif ($#ARGV > 1) {
warn "Ignoring so many arguments, just picking the first...";
$path = $ARGV[0];
}
##
# Open up the `find-broken-symlinks-ignore.txt` hidden file and fetch the list
# of patterns to be ignored.
my $file = catfile($ENV{'HOME'}, '.find-broken-symlinks-ignore.txt');
my @ignored = ();
open my $in, '<', $file or die "Can't open file $file";
while (<$in>) {
my $line = $_;
chomp($line);
push @ignored, $line;
}
close($in);
##
# Let's execute the command. We will show the output live, that's why we are
# using IO::Select instead of backticks. Idea taken from:
# https://stackoverflow.com/a/1243337.
my $output = 0;
my $detected = 0;
my $s = IO::Select->new();
open my $fh, '-|', "find -L $path -type l -ls 2>/dev/null";
$s->add($fh);
while (my @readers = $s->can_read()) {
for my $fh (@readers) {
$detected = 0;
if (eof $fh) {
$s->remove($fh);
next;
}
my $l = <$fh>;
for my $i (@ignored) {
my $clean = $l;
chomp($clean);
if ($clean =~ /\Q$i\E/) {
$detected = 1;
next;
}
}
if (!$detected) {
$output = 1;
print $l;
}
}
}
close($fh);
##
# Exit status depending on whether there was any output or not (if there was any
# output it means that some links are broken, so we should skip them).
exit($output);
|
