bin/chkstow.in

   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
  18 use strict;
  19 use warnings;
  20
  21 require 5.006_001;
  22
  23 use File::Find;
  24 use Getopt::Long;
  25
  26 my $DEFAULT_TARGET = $ENV{STOW_DIR} || '/usr/local/';
  27
  28 our $Wanted   = \&bad_links;
  29 our %Package  = ();
  30 our $Stow_dir = '';
  31 our $Target   = $DEFAULT_TARGET;
  32
  33 # put the main loop into a block so that tests can load this as a module
  34 if ( not caller() ) {
  35     if (@ARGV == 0) {
  36         usage();
  37     }
  38     process_options();
  39     #check_stow($Target, $Wanted);
  40     check_stow();
  41 }
  42
  43 sub 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
  53 sub usage {
  54     print <<"EOT";
  55 USAGE: chkstow [options]
  56
  57 Options:
  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.
  65 EOT
  66     exit(0);
  67 }
  68
  69 sub 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
  90 sub 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
 102 sub bad_links {
 103     -l && !-e && print "Bogus link: $File::Find::name\n";
 104 }
 105
 106 # checking for files that are not owned by stow
 107 sub 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'?
 113 sub list {
 114     if (-l) {
 115         $_ = readlink;
 116         s{\A(?:\.\./)+stow/}{}g;
 117         s{/.*}{}g;
 118         $Package{$_} = 1;
 119     }
 120 }
 121
 122 1; # Hey, it's a module!
 123
 124 # Local variables:
 125 # mode: perl
 126 # End:
 127 # vim: ft=perl