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