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