git.maemo.org Git - pkg-perl/blob - deb-src/libfile-which-perl/libfile-which-perl-0.05/Which.pm

   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