127 lines
2.9 KiB
Perl
Executable file
127 lines
2.9 KiB
Perl
Executable file
#!@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
|
|
# End:
|
|
# vim: ft=perl
|