Which.pm
Go to the documentation of this file.
00001 # Original package File::Which downloaded from CPAN on 6/15/2012. This module 00002 # has been modified by Andreas Schuh on 6/15/2012 to make it part of BASIS. 00003 00004 package BASIS::File::Which; 00005 00006 use 5.004; 00007 use strict; 00008 use Exporter (); 00009 use File::Spec (); 00010 00011 use vars qw{$VERSION @ISA @EXPORT @EXPORT_OK}; 00012 BEGIN { 00013 $VERSION = '1.09'; 00014 @ISA = 'Exporter'; 00015 @EXPORT = 'which'; 00016 @EXPORT_OK = 'where'; 00017 } 00018 00019 use constant IS_VMS => ($^O eq 'VMS'); 00020 use constant IS_MAC => ($^O eq 'MacOS'); 00021 use constant IS_DOS => ($^O eq 'MSWin32' or $^O eq 'dos' or $^O eq 'os2'); 00022 00023 # For Win32 systems, stores the extensions used for 00024 # executable files 00025 # For others, the empty string is used 00026 # because 'perl' . '' eq 'perl' => easier 00027 my @PATHEXT = (''); 00028 if ( IS_DOS ) { 00029 # WinNT. PATHEXT might be set on Cygwin, but not used. 00030 if ( $ENV{PATHEXT} ) { 00031 push @PATHEXT, split ';', $ENV{PATHEXT}; 00032 } else { 00033 # Win9X or other: doesn't have PATHEXT, so needs hardcoded. 00034 push @PATHEXT, qw{.com .exe .bat}; 00035 } 00036 } elsif ( IS_VMS ) { 00037 push @PATHEXT, qw{.exe .com}; 00038 } 00039 00040 sub which { 00041 my ($exec) = @_; 00042 00043 return undef unless $exec; 00044 00045 # in case of absolute paths, return whether file exists or not 00046 if (File::Spec->file_name_is_absolute($exec)) { 00047 stat($exec); 00048 if ( 00049 # Executable, normal case 00050 -x _ 00051 or ( 00052 # MacOS doesn't mark as executable so we check -e 00053 IS_MAC 00054 || 00055 ( 00056 IS_DOS 00057 and 00058 grep { 00059 $exec =~ /$_\z/i 00060 } @PATHEXT[1..$#PATHEXT] 00061 ) 00062 # DOSish systems don't pass -x on 00063 # non-exe/bat/com files. so we check -e. 00064 # However, we don't want to pass -e on files 00065 # that aren't in PATHEXT, like README. 00066 and -e _ 00067 ) 00068 ) { 00069 return $exec; 00070 } 00071 # absolute file path is not an executable file 00072 return undef; 00073 } 00074 00075 my $all = wantarray; 00076 my @results = (); 00077 00078 # check for aliases first 00079 if ( IS_VMS ) { 00080 my $symbol = `SHOW SYMBOL $exec`; 00081 chomp($symbol); 00082 unless ( $? ) { 00083 return $symbol unless $all; 00084 push @results, $symbol; 00085 } 00086 } 00087 if ( IS_MAC ) { 00088 my @aliases = split /\,/, $ENV{Aliases}; 00089 foreach my $alias ( @aliases ) { 00090 # This has not been tested!! 00091 # PPT which says MPW-Perl cannot resolve `Alias $alias`, 00092 # let's just hope it's fixed 00093 if ( lc($alias) eq lc($exec) ) { 00094 chomp(my $file = `Alias $alias`); 00095 last unless $file; # if it failed, just go on the normal way 00096 return $file unless $all; 00097 push @results, $file; 00098 # we can stop this loop as if it finds more aliases matching, 00099 # it'll just be the same result anyway 00100 last; 00101 } 00102 } 00103 } 00104 00105 my @path = File::Spec->path; 00106 if ( IS_DOS or IS_VMS or IS_MAC ) { 00107 unshift @path, File::Spec->curdir; 00108 } 00109 00110 foreach my $base ( map { File::Spec->catfile($_, $exec) } @path ) { 00111 for my $ext ( @PATHEXT ) { 00112 my $file = $base.$ext; 00113 00114 # We don't want dirs (as they are -x) 00115 next if -d $file; 00116 00117 if ( 00118 # Executable, normal case 00119 -x _ 00120 or ( 00121 # MacOS doesn't mark as executable so we check -e 00122 IS_MAC 00123 || 00124 ( 00125 IS_DOS 00126 and 00127 grep { 00128 $file =~ /$_\z/i 00129 } @PATHEXT[1..$#PATHEXT] 00130 ) 00131 # DOSish systems don't pass -x on 00132 # non-exe/bat/com files. so we check -e. 00133 # However, we don't want to pass -e on files 00134 # that aren't in PATHEXT, like README. 00135 and -e _ 00136 ) 00137 ) { 00138 return $file unless $all; 00139 push @results, $file; 00140 } 00141 } 00142 } 00143 00144 if ( $all ) { 00145 return @results; 00146 } else { 00147 return undef; 00148 } 00149 } 00150 00151 sub where { 00152 # force wantarray 00153 my @res = which($_[0]); 00154 return @res; 00155 } 00156 00157 1; 00158 00159 __END__ 00160 00161 =pod 00162 00163 =head1 NAME 00164 00165 BASIS::File::Which - Portable implementation of the `which' utility 00166 00167 =head1 SYNOPSIS 00168 00169 use BASIS::File::Which; # exports which() 00170 use BASIS::File::Which qw(which where); # exports which() and where() 00171 00172 my $exe_path = which('perldoc'); 00173 00174 my @paths = where('perl'); 00175 - Or - 00176 my @paths = which('perl'); # an array forces search for all of them 00177 00178 =head1 DESCRIPTION 00179 00180 C<BASIS::File::Which> was created to be able to get the paths to executable programs 00181 on systems under which the `which' program wasn't implemented in the shell. 00182 00183 C<BASIS::File::Which> searches the directories of the user's C<PATH> (as returned by 00184 C<File::Spec-E<gt>path()>), looking for executable files having the name 00185 specified as a parameter to C<which()>. Under Win32 systems, which do not have a 00186 notion of directly executable files, but uses special extensions such as C<.exe> 00187 and C<.bat> to identify them, C<BASIS::File::Which> takes extra steps to assure that 00188 you will find the correct file (so for example, you might be searching for 00189 C<perl>, it'll try F<perl.exe>, F<perl.bat>, etc.) 00190 00191 Original package is File::Which downloaded from CPAN. This module has been modified 00192 by Andreas Schuh on 6/15/2012 in order to make it a subpackage of the SBIA namespace. 00193 00194 =head1 Steps Used on Win32, DOS, OS2 and VMS 00195 00196 =head2 Windows NT 00197 00198 Windows NT has a special environment variable called C<PATHEXT>, which is used 00199 by the shell to look for executable files. Usually, it will contain a list in 00200 the form C<.EXE;.BAT;.COM;.JS;.VBS> etc. If C<BASIS::File::Which> finds such an 00201 environment variable, it parses the list and uses it as the different 00202 extensions. 00203 00204 =head2 Windows 9x and other ancient Win/DOS/OS2 00205 00206 This set of operating systems don't have the C<PATHEXT> variable, and usually 00207 you will find executable files there with the extensions C<.exe>, C<.bat> and 00208 (less likely) C<.com>. C<BASIS::File::Which> uses this hardcoded list if it's running 00209 under Win32 but does not find a C<PATHEXT> variable. 00210 00211 =head2 VMS 00212 00213 Same case as Windows 9x: uses C<.exe> and C<.com> (in that order). 00214 00215 =head1 Functions 00216 00217 =head2 which($short_exe_name) 00218 00219 Exported by default. 00220 00221 C<$short_exe_name> is the name used in the shell to call the program (for 00222 example, C<perl>). 00223 00224 If it finds an executable with the name you specified, C<which()> will return 00225 the absolute path leading to this executable (for example, F</usr/bin/perl> or 00226 F<C:\Perl\Bin\perl.exe>). 00227 00228 If it does I<not> find the executable, it returns C<undef>. 00229 00230 If C<which()> is called in list context, it will return I<all> the 00231 matches. 00232 00233 =head2 where($short_exe_name) 00234 00235 Not exported by default. 00236 00237 Same as C<which($short_exe_name)> in array context. Same as the 00238 C<`where'> utility, will return an array containing all the path names 00239 matching C<$short_exe_name>. 00240 00241 =head1 BUGS AND CAVEATS 00242 00243 Not tested on VMS or MacOS, although there is platform specific code 00244 for those. Anyone who haves a second would be very kind to send me a 00245 report of how it went. 00246 00247 File::Spec adds the current directory to the front of PATH if on 00248 Win32, VMS or MacOS. I have no knowledge of those so don't know if the 00249 current directory is searced first or not. Could someone please tell 00250 me? 00251 00252 =head1 SUPPORT 00253 00254 Bugs should be reported via the CPAN bug tracker at 00255 00256 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=File-Which> 00257 00258 For other issues, contact the maintainer. 00259 00260 =head1 AUTHOR 00261 00262 Andreas Schuh E<lt>andreas.schuh.84@googlemail.comE<gt> 00263 00264 Adam Kennedy E<lt>adamk@cpan.orgE<gt> 00265 00266 Per Einar Ellefsen E<lt>pereinar@cpan.orgE<gt> 00267 00268 Modified by Andreas Schuh on 6/15/2012 in order to make it a subpackage 00269 of the SBIA namespace for inclusion with the BASIS package. Moreover, 00270 changed which() function to deal with given absolute file paths differently. 00271 00272 Originated in F<modperl-2.0/lib/Apache/Build.pm>. Changed for use in DocSet 00273 (for the mod_perl site) and Win32-awareness by me, with slight modifications 00274 by Stas Bekman, then extracted to create C<BASIS::File::Which>. 00275 00276 Version 0.04 had some significant platform-related changes, taken from 00277 the Perl Power Tools C<`which'> implementation by Abigail with 00278 enhancements from Peter Prymmer. See 00279 L<http://www.perl.com/language/ppt/src/which/index.html> for more 00280 information. 00281 00282 =head1 COPYRIGHT 00283 00284 Copyright 2002 Per Einar Ellefsen. 00285 00286 Some parts copyright 2009 Adam Kennedy. 00287 Some parts copyright 2012 University of Pennsylvania. 00288 00289 This program is free software; you can redistribute it and/or modify 00290 it under the same terms as Perl itself. 00291 00292 =head1 SEE ALSO 00293 00294 L<File::Spec>, L<which(1)>, Perl Power Tools: 00295 L<http://www.perl.com/language/ppt/index.html>. 00296 00297 =cut