editfind

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Carp;
   5 use FindBin;
   6 use Getopt::Std;
   7
   8 use Data::Dumper;
   9
  10 use File::Spec;
  11
  12 sub usage {
  13   my $message = shift || '';
  14   $message = "Error: $message\n" if $message;
  15   die <<EOU;
  16 $message
  17 Usage:
  18   $FindBin::Script
  19
  20   Given a list of filenames, resolve any that look like perl module or script names.
  21
  22   Options:
  23
  24     none yet
  25
  26 EOU
  27 }
  28 sub HELP_MESSAGE {usage()}
  29
  30 our %opt;
  31 getopts('',\%opt) or usage();
  32
  33
  34 my @res = map resolve($_), @ARGV;
  35 die "too many results\n" if @res > 5;
  36 foreach (@res) {
  37   -f or die "$_ not found\n";
  38   print "$_\n";
  39 }
  40
  41 sub resolve {
  42   my ($name) = @_;
  43
  44   my @resolvers = ( \&resolve_file,
  45                     \&resolve_perlmod,
  46                     \&resolve_exec,
  47                   );
  48
  49   foreach my $res ( @resolvers ) {
  50     if( my @names = $res->($name) ) {
  51       return @names;
  52     }
  53   }
  54   die "$name not found in file system, perl modules or perl scripts\n";
  55 }
  56
  57 sub resolve_file {
  58   my ($name) = @_;
  59
  60   return $name if -f $name;
  61
  62   return "./$name" if -f "./$name";
  63   return;
  64 }
  65
  66 sub resolve_perlmod {
  67   my ($name) = @_;
  68   return unless $name =~ /^\w+(::\w+)*$/;
  69
  70   my @comp = split /:+/,$name;
  71   $comp[-1] .= '.pm';
  72
  73   # so we can find modules in t/lib
  74   my @test_INC = map { s|/lib$|/t/lib| } @INC;
  75
  76   foreach my $inc ('.','./lib',@INC, @test_INC) {
  77     my $fn = File::Spec->catfile($inc,@comp);
  78     return $fn if -f $fn;
  79   }
  80   return;
  81 }
  82
  83 sub resolve_exec {
  84   my ($name) = @_;
  85
  86   return if $name =~ m|/|;
  87
  88   return map {
  89     my $path = $_;
  90     my $f = File::Spec->catfile($path,$name);
  91     return $f if -f $f; #<return just the one if exact match
  92     grep !/~$/, glob( "$f*") #< otherwise, glob with that as the base
  93   } split /:/,$ENV{PATH};
  94
  95 }