Filename | /usr/lib64/perl5/vendor_perl/5.16.0/File/Which.pm |
Statements | Executed 22 statements in 4.92ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 6.50ms | 92.6ms | BEGIN@16 | File::Which::
1 | 1 | 1 | 99µs | 99µs | BEGIN@3 | File::Which::
1 | 1 | 1 | 81µs | 81µs | BEGIN@9 | File::Which::
1 | 1 | 1 | 65µs | 264µs | BEGIN@17 | File::Which::
1 | 1 | 1 | 65µs | 268µs | BEGIN@18 | File::Which::
1 | 1 | 1 | 53µs | 144µs | BEGIN@4 | File::Which::
1 | 1 | 1 | 47µs | 430µs | BEGIN@8 | File::Which::
1 | 1 | 1 | 22µs | 22µs | BEGIN@5 | File::Which::
1 | 1 | 1 | 21µs | 21µs | BEGIN@6 | File::Which::
0 | 0 | 0 | 0s | 0s | where | File::Which::
0 | 0 | 0 | 0s | 0s | which | File::Which::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package File::Which; | ||||
2 | |||||
3 | 2 | 305µs | 1 | 99µs | # spent 99µs within File::Which::BEGIN@3 which was called:
# once (99µs+0s) by RTP::Webmerge::BEGIN@15 at line 3 # spent 99µs making 1 call to File::Which::BEGIN@3 |
4 | 2 | 136µs | 2 | 236µs | # spent 144µs (53+92) within File::Which::BEGIN@4 which was called:
# once (53µs+92µs) by RTP::Webmerge::BEGIN@15 at line 4 # spent 144µs making 1 call to File::Which::BEGIN@4
# spent 92µs making 1 call to strict::import |
5 | 2 | 117µs | 1 | 22µs | # spent 22µs within File::Which::BEGIN@5 which was called:
# once (22µs+0s) by RTP::Webmerge::BEGIN@15 at line 5 # spent 22µs making 1 call to File::Which::BEGIN@5 |
6 | 2 | 140µs | 1 | 21µs | # spent 21µs within File::Which::BEGIN@6 which was called:
# once (21µs+0s) by RTP::Webmerge::BEGIN@15 at line 6 # spent 21µs making 1 call to File::Which::BEGIN@6 |
7 | |||||
8 | 2 | 288µs | 2 | 814µs | # spent 430µs (47+383) within File::Which::BEGIN@8 which was called:
# once (47µs+383µs) by RTP::Webmerge::BEGIN@15 at line 8 # spent 430µs making 1 call to File::Which::BEGIN@8
# spent 383µs making 1 call to vars::import |
9 | # spent 81µs within File::Which::BEGIN@9 which was called:
# once (81µs+0s) by RTP::Webmerge::BEGIN@15 at line 14 | ||||
10 | 1 | 3µs | $VERSION = '1.09'; | ||
11 | 1 | 46µs | @ISA = 'Exporter'; | ||
12 | 1 | 6µs | @EXPORT = 'which'; | ||
13 | 1 | 85µs | @EXPORT_OK = 'where'; | ||
14 | 1 | 168µs | 1 | 81µs | } # spent 81µs making 1 call to File::Which::BEGIN@9 |
15 | |||||
16 | 2 | 835µs | 2 | 92.9ms | # spent 92.6ms (6.50+86.1) within File::Which::BEGIN@16 which was called:
# once (6.50ms+86.1ms) by RTP::Webmerge::BEGIN@15 at line 16 # spent 92.6ms making 1 call to File::Which::BEGIN@16
# spent 278µs making 1 call to constant::import |
17 | 2 | 327µs | 2 | 463µs | # spent 264µs (65+199) within File::Which::BEGIN@17 which was called:
# once (65µs+199µs) by RTP::Webmerge::BEGIN@15 at line 17 # spent 264µs making 1 call to File::Which::BEGIN@17
# spent 199µs making 1 call to constant::import |
18 | 2 | 2.44ms | 2 | 472µs | # spent 268µs (65+203) within File::Which::BEGIN@18 which was called:
# once (65µs+203µs) by RTP::Webmerge::BEGIN@15 at line 18 # spent 268µs making 1 call to File::Which::BEGIN@18
# spent 203µs making 1 call to constant::import |
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 | 1 | 7µs | 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 | 16µs | 1; | ||
125 | |||||
126 | __END__ |