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
|
#!/usr/bin/env perl
use strict;
use warnings;
require 5.006_001;
use File::Find;
use Getopt::Long;
my $DEFAULT_TARGET = '/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 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
|
