test/src/locate.pl

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