bin/chkstow.in

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