test/src/locate.pl

   1 #!/usr/bin/env perl
   2
   3 use 5.010;
   4 use strict;
   5 use warnings;
   6 use File::Find;
   7 use Cwd;
   8
   9 my @dirs = grep { /^\// && -d } split(/:/, $ENV{PATH}), qw(
  10   /bin
  11   /usr/bin
  12   /usr/sbin
  13   /usr/libexec
  14   /usr/local/bin
  15   /usr/local/sbin
  16   /usr/local
  17   /opt
  18 );
  19
  20 my %path = map { $_ => locate($_, @dirs) } @ARGV;
  21
  22 mkdir 'bin.sys'
  23   or die "bin.sys: $!"
  24   if not -d 'bin.sys';
  25
  26 foreach my $tool (keys %path) {
  27     next if not defined $path{$tool};
  28     print "$tool $path{$tool}\n";
  29
  30     unlink "bin.sys/$tool";
  31     symlink $path{$tool}, "bin.sys/$tool"
  32       or warn "bin.sys/$tool -> $path{$tool}: $!\n";
  33 }
  34
  35 sub locate {
  36     my ($tool, @dirs) = @_;
  37
  38     # use die to break out of the find as soon
  39     # as we found it
  40     my $cwd = cwd;
  41     eval {
  42         find(
  43             sub {
  44                 return $File::Find::prune = 1 unless -r -x -r;
  45                 return unless $tool eq $_ and -x and -f _;
  46                 die { found => $File::Find::name };
  47             },
  48             @dirs
  49         );
  50     };
  51     chdir $cwd;
  52
  53     return (ref $@ eq ref {} and $@->{found}) ? $@->{found} : undef;
  54 }