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
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
#!@PERL@
#
# This file is part of GNU Stow.
#
# GNU Stow 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.
#
# GNU Stow 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 https://www.gnu.org/licenses/.
use strict;
use warnings;
require 5.006_001;
use File::Find;
use Getopt::Long;
my $DEFAULT_TARGET = $ENV{STOW_DIR} || '/usr/local/';
our $Wanted = \&bad_links;
our %Package = ();
our $Stow_dir = '';
our $Target = $DEFAULT_TARGET;
# put the main loop into a block so that tests can load this as a module
if ( not caller() ) {
if (@ARGV == 0) {
usage();
}
process_options();
#check_stow($Target, $Wanted);
check_stow();
}
sub process_options {
GetOptions(
'b|badlinks' => sub { $Wanted = \&bad_links },
'a|aliens' => sub { $Wanted = \&aliens },
'l|list' => sub { $Wanted = \&list },
't|target=s' => \$Target,
) or usage();
return;
}
sub usage {
print <<"EOT";
USAGE: chkstow [options]
Options:
-t DIR, --target=DIR Set the target directory to DIR
(default is $DEFAULT_TARGET)
-b, --badlinks Report symlinks that point to non-existent files
-a, --aliens Report non-symlinks in the target directory
-l, --list List packages in the target directory
--badlinks is the default mode.
EOT
exit(0);
}
sub check_stow {
#my ($Target, $Wanted) = @_;
my (%options) = (
wanted => $Wanted,
preprocess => \&skip_dirs,
);
find(\%options, $Target);
if ($Wanted == \&list) {
delete $Package{''};
delete $Package{'..'};
if (keys %Package) {
print map "$_\n", sort(keys %Package);
}
}
return;
}
sub skip_dirs {
# skip stow source and unstowed targets
if (-e ".stow" || -e ".notstowed" ) {
warn "skipping $File::Find::dir\n";
return ();
}
else {
return @_;
}
}
# checking for files that do not link to anything
sub bad_links {
-l && !-e && print "Bogus link: $File::Find::name\n";
}
# checking for files that are not owned by stow
sub aliens {
!-l && !-d && print "Unstowed file: $File::Find::name\n";
}
# just list the packages in the target directory
# FIXME: what if the stow dir is not called 'stow'?
sub list {
if (-l) {
$_ = readlink;
s{\A(?:\.\./)+stow/}{}g;
s{/.*}{}g;
$Package{$_} = 1;
}
}
1; # Hey, it's a module!
# Local variables:
# mode: perl
# cperl-indent-level: 4
# End:
# vim: ft=perl
|
