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