| 1 | package Psh::Builtins::Which; |
| 2 | |
| 3 | require Psh::Util; |
| 4 | require Getopt::Std; |
| 5 | |
| 6 | =item * C<which command> |
| 7 | |
| 8 | Locates the command in the filesystem. |
| 9 | |
| 10 | =item * C<which -m module> |
| 11 | |
| 12 | Locates the perl module in the filesystem |
| 13 | |
| 14 | =item * C<which -r module> |
| 15 | |
| 16 | Locates a command using a Perl regexp |
| 17 | |
| 18 | Option C<-a> may be used to see more than one match. |
| 19 | Option C<-v> switches to a more verbose output. |
| 20 | |
| 21 | =cut |
| 22 | |
| 23 | sub parse_version |
| 24 | { |
| 25 | my $file= shift; |
| 26 | open(FILE,"< $file"); |
| 27 | my $inpod=0; |
| 28 | my $result; |
| 29 | while (<FILE>) { |
| 30 | chomp; |
| 31 | $inpod = /^=(?!cut)/ ? 1: /^=cut/ ? 0 : $inpod; |
| 32 | next if $inpod; |
| 33 | next unless /([\$*])(([\w\:\']*)\bVERSION)\b.*\=/; |
| 34 | my $eval= qq{ |
| 35 | package Psh::_version; |
| 36 | no strict; |
| 37 | |
| 38 | local $1$2; |
| 39 | \$$2=undef; do { |
| 40 | $_ |
| 41 | }; \$$2 |
| 42 | }; |
| 43 | no warnings; |
| 44 | $result= eval($eval); |
| 45 | last; |
| 46 | } |
| 47 | close(FILE); |
| 48 | $result = 'undef' unless defined $result; |
| 49 | return $result; |
| 50 | } |
| 51 | |
| 52 | sub bi_which |
| 53 | { |
| 54 | my $line= shift; |
| 55 | local @ARGV = @{shift()}; |
| 56 | my $opt={}; |
| 57 | Getopt::Std::getopts('aprmv',$opt); |
| 58 | my $rest= join(' ',@ARGV); |
| 59 | |
| 60 | if ($opt->{'m'}) { # perl module search |
| 61 | $rest=~ s/::/$Psh::OS::FILE_SEPARATOR/g; |
| 62 | my $foundsth=0; |
| 63 | foreach my $dir (@Psh::origINC) { |
| 64 | next unless $dir; |
| 65 | my $file= Psh::OS::catfile($dir,$rest.'.pm'); |
| 66 | if (-r $file) { |
| 67 | Psh::Util::print_out($file); |
| 68 | if ($opt->{v}) { |
| 69 | my $version= parse_version($file); |
| 70 | Psh::Util::print_out(" $version"); |
| 71 | } |
| 72 | Psh::Util::print_out("\n"); |
| 73 | $foundsth=1; |
| 74 | last unless $opt->{a}; |
| 75 | } |
| 76 | } |
| 77 | return (1,undef) if $foundsth; |
| 78 | } else { |
| 79 | if ($opt->{'r'}) { |
| 80 | my $foundsth=0; |
| 81 | Psh::Util::recalc_absed_path(); |
| 82 | foreach my $dir (@Psh::absed_path) { |
| 83 | next unless $dir; |
| 84 | opendir(DIR, $dir); |
| 85 | while (my $tmp= readdir(DIR)) { |
| 86 | next unless $tmp=~/$rest/; |
| 87 | $tmp= Psh::OS::catfile($dir,$tmp); |
| 88 | next unless -f $tmp; |
| 89 | next unless -x _; |
| 90 | Psh::Util::print_out("$tmp\n"); |
| 91 | $foundsth=1; |
| 92 | last unless $opt->{a}; |
| 93 | } |
| 94 | closedir(DIR); |
| 95 | last if $foundsth and !$opt->{a}; |
| 96 | } |
| 97 | return (1,undef) if $foundsth; |
| 98 | } else { |
| 99 | if ($rest) { |
| 100 | my @tmp=(); |
| 101 | push @tmp, Psh::Util::which($rest,$opt->{'a'}?1:0); |
| 102 | foreach (@tmp) { |
| 103 | Psh::Util::print_out("$_\n"); |
| 104 | } |
| 105 | return (1,undef) if @tmp; |
| 106 | } |
| 107 | } |
| 108 | } |
| 109 | return (0,undef); |
| 110 | } |
| 111 | |
| 112 | 1; |