File Coverage

File:local/lib/perl5/File/Which.pm
Coverage:81.1%

linestmtbrancondsubtimecode
1package File::Which;
2
3
2
2
2
17
5
use 5.004;
4
2
2
2
2
4
2
25
use strict;
5
2
2
2
2
5
1
10
use Exporter   ();
6
2
2
2
2
4
2
19
use File::Spec ();
7
8
2
2
2
2
4
1
106
use vars qw{$VERSION @ISA @EXPORT @EXPORT_OK};
9BEGIN {
10
2
2
2
        $VERSION   = '1.09';
11
2
11
        @ISA       = 'Exporter';
12
2
2
        @EXPORT    = 'which';
13
2
27
        @EXPORT_OK = 'where';
14}
15
16
2
2
2
2
5
1
71
use constant IS_VMS => ($^O eq 'VMS');
17
2
2
2
2
6
1
60
use constant IS_MAC => ($^O eq 'MacOS');
18
2
2
2
33
2
5
1
647
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
24my @PATHEXT = ('');
25if ( 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
37sub which {
38
4
4
4
        my ($exec) = @_;
39
40
4
50
6
        return undef unless $exec;
41
42
4
4
        my $all = wantarray;
43
4
4
        my @results = ();
44
45        # check for aliases first
46
4
1
        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
4
2
        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
4
65
        my @path = File::Spec->path;
73
4
4
        if ( IS_DOS or IS_VMS or IS_MAC ) {
74                unshift @path, File::Spec->curdir;
75        }
76
77
4
128
4
312
        foreach my $base ( map { File::Spec->catfile($_, $exec) } @path ) {
78
112
56
                for my $ext ( @PATHEXT ) {
79
112
50
                        my $file = $base.$ext;
80
81                        # We don't want dirs (as they are -x)
82
112
50
193
                        next if -d $file;
83
84
112
100
100
196
                        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
4
50
15
                                return $file unless $all;
106
0
                                push @results, $file;
107                        }
108                }
109        }
110
111
0
0
        if ( $all ) {
112
0
                return @results;
113        } else {
114
0
                return undef;
115        }
116}
117
118sub where {
119        # force wantarray
120
0
0
        my @res = which($_[0]);
121
0
        return @res;
122}
123
1241;
125