1#!@PERL@
2#
3# This file is part of GNU Stow.
4#
5# GNU Stow is free software: you can redistribute it and/or modify it
6# under the terms of the GNU General Public License as published by
7# the Free Software Foundation, either version 3 of the License, or
8# (at your option) any later version.
9#
10# GNU Stow is distributed in the hope that it will be useful, but
11# WITHOUT ANY WARRANTY; without even the implied warranty of
12# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13# General Public License for more details.
14#
15# You should have received a copy of the GNU General Public License
16# along with this program. If not, see https://www.gnu.org/licenses/.
17
18use strict;
19use warnings;
20
21require 5.006_001;
22
23use File::Find;
24use Getopt::Long;
25
26my $DEFAULT_TARGET = $ENV{STOW_DIR} || '/usr/local/';
27
28our $Wanted   = \&bad_links;
29our %Package  = ();
30our $Stow_dir = '';
31our $Target   = $DEFAULT_TARGET;
32
33# put the main loop into a block so that tests can load this as a module
34if ( not caller() ) {
35    if (@ARGV == 0) {
36        usage();
37    }
38    process_options();
39    #check_stow($Target, $Wanted);
40    check_stow();
41}
42
43sub process_options {
44    GetOptions(
45	'b|badlinks' => sub { $Wanted = \&bad_links },
46	'a|aliens'   => sub { $Wanted = \&aliens    },
47	'l|list'     => sub { $Wanted = \&list      },
48	't|target=s' => \$Target,
49	) or usage();
50    return;
51}
52
53sub usage {
54    print <<"EOT";
55USAGE: chkstow [options]
56
57Options:
58    -t DIR, --target=DIR  Set the target directory to DIR
59                          (default is $DEFAULT_TARGET)
60    -b, --badlinks        Report symlinks that point to non-existent files
61    -a, --aliens          Report non-symlinks in the target directory
62    -l, --list            List packages in the target directory
63
64--badlinks is the default mode.
65EOT
66    exit(0);
67}
68
69sub check_stow {
70    #my ($Target, $Wanted) = @_;
71
72    my (%options) = (
73        wanted     => $Wanted,
74        preprocess => \&skip_dirs,
75    );
76
77    find(\%options, $Target);
78
79    if ($Wanted == \&list) {
80        delete $Package{''};
81        delete $Package{'..'};
82
83        if (keys %Package) {
84            print map "$_\n", sort(keys %Package);
85        }
86    }
87    return;
88}
89
90sub skip_dirs {
91    # skip stow source and unstowed targets
92    if (-e ".stow" || -e ".notstowed" ) {
93        warn "skipping $File::Find::dir\n";
94        return ();
95    }
96    else {
97        return @_;
98    }
99}
100
101# checking for files that do not link to anything
102sub bad_links {
103    -l && !-e && print "Bogus link: $File::Find::name\n";
104}
105
106# checking for files that are not owned by stow
107sub aliens  {
108    !-l && !-d && print "Unstowed file: $File::Find::name\n";
109}
110
111# just list the packages in the target directory
112# FIXME: what if the stow dir is not called 'stow'?
113sub list {
114    if (-l) {
115        $_ = readlink;
116        s{\A(?:\.\./)+stow/}{}g;
117        s{/.*}{}g;
118        $Package{$_} = 1;
119    }
120}
121
1221; # Hey, it's a module!
123
124# Local variables:
125# mode: perl
126# cperl-indent-level: 4
127# End:
128# vim: ft=perl
129