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/lib
  14   /usr/libexec
  15   /usr/local/bin
  16   /usr/local/sbin
  17   /usr/local
  18   /opt
  19 );
  20
  21 my %path = map { $_ => locate($_, @dirs) } @ARGV;
  22
  23 mkdir 'bin.sys'
  24   or die "bin.sys: $!"
  25   if not -d 'bin.sys';
  26
  27 foreach my $tool (keys %path) {
  28     next if not defined $path{$tool};
  29     print "$tool $path{$tool}\n";
  30
  31     unlink "bin.sys/$tool";
  32     symlink $path{$tool}, "bin.sys/$tool"
  33       or warn "bin.sys/$tool -> $path{$tool}: $!\n";
  34 }
  35
  36 sub locate {
  37     my ($tool, @dirs) = @_;
  38
  39     # use die to break out of the find as soon
  40     # as we found it
  41     my $cwd = cwd;
  42     eval {
  43         find(
  44             sub {
  45                 return $File::Find::prune = 1 unless -r -x -r;
  46                 return unless $tool eq $_ and -x and -f _;
  47                 die { found => $File::Find::name };
  48             },
  49             @dirs
  50         );
  51     };
  52     chdir $cwd;
  53
  54     return (ref $@ eq ref {} and $@->{found}) ? $@->{found} : undef;
  55 }