local-lib5/lib/perl5/File/Which.pm

   1 package File::Which;
   2
   3 use 5.004;
   4 use strict;
   5 use Exporter   ();
   6 use File::Spec ();
   7
   8 use vars qw{$VERSION @ISA @EXPORT @EXPORT_OK};
   9 BEGIN {
  10         $VERSION   = '1.09';
  11         @ISA       = 'Exporter';
  12         @EXPORT    = 'which';
  13         @EXPORT_OK = 'where';
  14 }
  15
  16 use constant IS_VMS => ($^O eq 'VMS');
  17 use constant IS_MAC => ($^O eq 'MacOS');
  18 use constant IS_DOS => ($^O eq 'MSWin32' or $^O eq 'dos' or $^O eq 'os2');
  19
  20 # For Win32 systems, stores the extensions used for
  21 # executable files
  22 # For others, the empty string is used
  23 # because 'perl' . '' eq 'perl' => easier
  24 my @PATHEXT = ('');
  25 if ( IS_DOS ) {
  26         # WinNT. PATHEXT might be set on Cygwin, but not used.
  27         if ( $ENV{PATHEXT} ) {
  28                 push @PATHEXT, split ';', $ENV{PATHEXT};
  29         } else {
  30                 # Win9X or other: doesn't have PATHEXT, so needs hardcoded.
  31                 push @PATHEXT, qw{.com .exe .bat};
  32         }
  33 } elsif ( IS_VMS ) {
  34         push @PATHEXT, qw{.exe .com};
  35 }
  36
  37 sub which {
  38         my ($exec) = @_;
  39
  40         return undef unless $exec;
  41
  42         my $all = wantarray;
  43         my @results = ();
  44
  45         # check for aliases first
  46         if ( IS_VMS ) {
  47                 my $symbol = `SHOW SYMBOL $exec`;
  48                 chomp($symbol);
  49                 unless ( $? ) {
  50                         return $symbol unless $all;
  51                         push @results, $symbol;
  52                 }
  53         }
  54         if ( IS_MAC ) {
  55                 my @aliases = split /\,/, $ENV{Aliases};
  56                 foreach my $alias ( @aliases ) {
  57                         # This has not been tested!!
  58                         # PPT which says MPW-Perl cannot resolve `Alias $alias`,
  59                         # let's just hope it's fixed
  60                         if ( lc($alias) eq lc($exec) ) {
  61                                 chomp(my $file = `Alias $alias`);
  62                                 last unless $file;  # if it failed, just go on the normal way
  63                                 return $file unless $all;
  64                                 push @results, $file;
  65                                 # we can stop this loop as if it finds more aliases matching,
  66                                 # it'll just be the same result anyway
  67                                 last;
  68                         }
  69                 }
  70         }
  71
  72         my @path = File::Spec->path;
  73         if ( IS_DOS or IS_VMS or IS_MAC ) {
  74                 unshift @path, File::Spec->curdir;
  75         }
  76
  77         foreach my $base ( map { File::Spec->catfile($_, $exec) } @path ) {
  78                 for my $ext ( @PATHEXT ) {
  79                         my $file = $base.$ext;
  80
  81                         # We don't want dirs (as they are -x)
  82                         next if -d $file;
  83
  84                         if (
  85                                 # Executable, normal case
  86                                 -x _
  87                                 or (
  88                                         # MacOS doesn't mark as executable so we check -e
  89                                         IS_MAC
  90                                         ||
  91                                         (
  92                                                 IS_DOS
  93                                                 and
  94                                                 grep {
  95                                                         $file =~ /$_\z/i
  96                                                 } @PATHEXT[1..$#PATHEXT]
  97                                         )
  98                                         # DOSish systems don't pass -x on
  99                                         # non-exe/bat/com files. so we check -e.
 100                                         # However, we don't want to pass -e on files
 101                                         # that aren't in PATHEXT, like README.
 102                                         and -e _
 103                                 )
 104                         ) {
 105                                 return $file unless $all;
 106                                 push @results, $file;
 107                         }
 108                 }
 109         }
 110
 111         if ( $all ) {
 112                 return @results;
 113         } else {
 114                 return undef;
 115         }
 116 }
 117
 118 sub where {
 119         # force wantarray
 120         my @res = which($_[0]);
 121         return @res;
 122 }
 123
 124 1;
 125
 126 __END__
 127
 128 =pod
 129
 130 =head1 NAME
 131
 132 File::Which - Portable implementation of the `which' utility
 133
 134 =head1 SYNOPSIS
 135
 136   use File::Which;                  # exports which()
 137   use File::Which qw(which where);  # exports which() and where()
 138
 139   my $exe_path = which('perldoc');
 140
 141   my @paths = where('perl');
 142   - Or -
 143   my @paths = which('perl'); # an array forces search for all of them
 144
 145 =head1 DESCRIPTION
 146
 147 C<File::Which> was created to be able to get the paths to executable programs
 148 on systems under which the `which' program wasn't implemented in the shell.
 149
 150 C<File::Which> searches the directories of the user's C<PATH> (as returned by
 151 C<File::Spec-E<gt>path()>), looking for executable files having the name
 152 specified as a parameter to C<which()>. Under Win32 systems, which do not have a
 153 notion of directly executable files, but uses special extensions such as C<.exe>
 154 and C<.bat> to identify them, C<File::Which> takes extra steps to assure that
 155 you will find the correct file (so for example, you might be searching for
 156 C<perl>, it'll try F<perl.exe>, F<perl.bat>, etc.)
 157
 158 =head1 Steps Used on Win32, DOS, OS2 and VMS
 159
 160 =head2 Windows NT
 161
 162 Windows NT has a special environment variable called C<PATHEXT>, which is used
 163 by the shell to look for executable files. Usually, it will contain a list in
 164 the form C<.EXE;.BAT;.COM;.JS;.VBS> etc. If C<File::Which> finds such an
 165 environment variable, it parses the list and uses it as the different
 166 extensions.
 167
 168 =head2 Windows 9x and other ancient Win/DOS/OS2
 169
 170 This set of operating systems don't have the C<PATHEXT> variable, and usually
 171 you will find executable files there with the extensions C<.exe>, C<.bat> and
 172 (less likely) C<.com>. C<File::Which> uses this hardcoded list if it's running
 173 under Win32 but does not find a C<PATHEXT> variable.
 174
 175 =head2 VMS
 176
 177 Same case as Windows 9x: uses C<.exe> and C<.com> (in that order).
 178
 179 =head1 Functions
 180
 181 =head2 which($short_exe_name)
 182
 183 Exported by default.
 184
 185 C<$short_exe_name> is the name used in the shell to call the program (for
 186 example, C<perl>).
 187
 188 If it finds an executable with the name you specified, C<which()> will return
 189 the absolute path leading to this executable (for example, F</usr/bin/perl> or
 190 F<C:\Perl\Bin\perl.exe>).
 191
 192 If it does I<not> find the executable, it returns C<undef>.
 193
 194 If C<which()> is called in list context, it will return I<all> the
 195 matches.
 196
 197 =head2 where($short_exe_name)
 198
 199 Not exported by default.
 200
 201 Same as C<which($short_exe_name)> in array context. Same as the
 202 C<`where'> utility, will return an array containing all the path names
 203 matching C<$short_exe_name>.
 204
 205 =head1 BUGS AND CAVEATS
 206
 207 Not tested on VMS or MacOS, although there is platform specific code
 208 for those. Anyone who haves a second would be very kind to send me a
 209 report of how it went.
 210
 211 File::Spec adds the current directory to the front of PATH if on
 212 Win32, VMS or MacOS. I have no knowledge of those so don't know if the
 213 current directory is searced first or not. Could someone please tell
 214 me?
 215
 216 =head1 SUPPORT
 217
 218 Bugs should be reported via the CPAN bug tracker at
 219
 220 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=File-Which>
 221
 222 For other issues, contact the maintainer.
 223
 224 =head1 AUTHOR
 225
 226 Adam Kennedy E<lt>adamk@cpan.orgE<gt>
 227
 228 Per Einar Ellefsen E<lt>pereinar@cpan.orgE<gt>
 229
 230 Originated in F<modperl-2.0/lib/Apache/Build.pm>. Changed for use in DocSet
 231 (for the mod_perl site) and Win32-awareness by me, with slight modifications
 232 by Stas Bekman, then extracted to create C<File::Which>.
 233
 234 Version 0.04 had some significant platform-related changes, taken from
 235 the Perl Power Tools C<`which'> implementation by Abigail with
 236 enhancements from Peter Prymmer. See
 237 L<http://www.perl.com/language/ppt/src/which/index.html> for more
 238 information.
 239
 240 =head1 COPYRIGHT
 241
 242 Copyright 2002 Per Einar Ellefsen.
 243
 244 Some parts copyright 2009 Adam Kennedy.
 245
 246 This program is free software; you can redistribute it and/or modify
 247 it under the same terms as Perl itself.
 248
 249 =head1 SEE ALSO
 250
 251 L<File::Spec>, L<which(1)>, Perl Power Tools:
 252 L<http://www.perl.com/language/ppt/index.html>.
 253
 254 =cut