home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / share / perl5 / File / Which.pm < prev   
Encoding:
Perl POD Document  |  2009-09-14  |  6.5 KB  |  255 lines
  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.08';
  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
  255.