chkstow.in

   1 #!@PERL@
   2
   3 use strict;
   4 use warnings;
   5
   6 use File::Find;
   7 use Getopt::Long;
   8
   9 our $Wanted = \&bad_links;
  10 our %Package=();
  11 our $Stow_dir = '';
  12 our $Target = q{/usr/local/};
  13
  14 # put the main loop into a block so that tests can load this as a module
  15 if ( not caller() ) {
  16     if (@ARGV == 0) {
  17         usage();
  18     }
  19     process_options();
  20     #check_stow($Target, $Wanted);
  21     check_stow();
  22 }
  23
  24 sub process_options {
  25     GetOptions(
  26         'b|badlinks' => sub { $Wanted = \&bad_links },
  27         'a|aliens'   => sub { $Wanted = \&aliens    },
  28         'l|list'     => sub { $Wanted = \&list      },
  29         't|target=s' => \$Target,
  30         ) or usage();
  31     return;
  32 }
  33
  34 sub usage {
  35     print <<"EOT";
  36 USAGE: chkstow [options]
  37
  38 Options:
  39     -b, --badlinks        Report symlinks that point to non-existant files.
  40     -a, --aliens          Report non-symlinks in the target directory.
  41     -l, --list            List packages in the target directory.
  42     -t DIR, --target=DIR  Set the target directory to DIR (default
  43                                                            is /usr/local)
  44 EOT
  45     exit(0);
  46 }
  47
  48 sub check_stow {
  49     #my ($Target, $Wanted) = @_;
  50
  51     my (%options) = (
  52         wanted     => $Wanted,
  53         preprocess => \&skip_dirs,
  54     );
  55
  56     find(\%options, $Target);
  57
  58     if ($Wanted == \&list) {
  59         delete $Package{''};
  60         delete $Package{'..'};
  61
  62         if (keys %Package) {
  63             local $,="\n";
  64             print sort(keys %Package), "\n";
  65         }
  66     }
  67     return;
  68 }
  69
  70 sub skip_dirs {
  71     # skip stow source and unstowed targets
  72     if (-e ".stow" || -e ".notstowed" ) {
  73         warn "skipping $File::Find::dir\n";
  74         return ();
  75     }
  76     else {
  77         return @_;
  78     }
  79 }
  80
  81 # checking for files that do not link to anything
  82 sub bad_links {
  83     -l && !-e && print "Bogus link: $File::Find::name\n";
  84 }
  85
  86 # checking for files that are not owned by stow
  87 sub aliens  {
  88     !-l && !-d && print "Unstowed file: $File::Find::name\n";
  89 }
  90
  91 # just list the packages in the the target directory
  92 # FIXME: what if the stow dir is not called 'stow'?
  93 sub list {
  94     if (-l) {
  95         $_ = readlink;
  96         s{\A(?:\.\./)+stow/}{}g;
  97         s{/.*}{}g;
  98         $Package{$_} = 1;
  99     }
 100 }
 101
 102 1; # Hey, it's a module!
 103
 104 # vim:ft=perl