Profile of /usr/local/lib/perl5/5.10.1/darwin-2level/Cwd.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For 05.Domain_and_Item.t
Run on Tue May 4 17:21:41 2010
Reported on Tue May 4 17:22:20 2010

File | /usr/local/lib/perl5/5.10.1/darwin-2level/Cwd.pm
Statements Executed | 58
Statement Execution Time | 3.56ms

Subroutines — ordered by exclusive time
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 2 | 52µs | 52µs | Cwd::::getcwdCwd::getcwd (xsub)
1 | 1 | 1 | 38µs | 50µs | Cwd::::BEGIN@170Cwd::BEGIN@170
1 | 1 | 1 | 28µs | 78µs | Cwd::::BEGIN@171Cwd::BEGIN@171
1 | 1 | 2 | 15µs | 15µs | Cwd::::CORE:fteexecCwd::CORE:fteexec (opcode)
1 | 1 | 1 | 15µs | 48µs | Cwd::::BEGIN@811Cwd::BEGIN@811
1 | 1 | 1 | 14µs | 118µs | Cwd::::BEGIN@172Cwd::BEGIN@172
1 | 1 | 1 | 11µs | 11µs | Cwd::::BEGIN@209Cwd::BEGIN@209
1 | 1 | 2 | 7µs | 7µs | Cwd::::CORE:regcompCwd::CORE:regcomp (opcode)
0 | 0 | 0 | 0s | 0s | Cwd::::__ANON__[:406]Cwd::__ANON__[:406]
0 | 0 | 0 | 0s | 0s | Cwd::::_backtick_pwdCwd::_backtick_pwd
0 | 0 | 0 | 0s | 0s | Cwd::::_carpCwd::_carp
0 | 0 | 0 | 0s | 0s | Cwd::::_croakCwd::_croak
0 | 0 | 0 | 0s | 0s | Cwd::::_dos_cwdCwd::_dos_cwd
0 | 0 | 0 | 0s | 0s | Cwd::::_epoc_cwdCwd::_epoc_cwd
0 | 0 | 0 | 0s | 0s | Cwd::::_os2_cwdCwd::_os2_cwd
0 | 0 | 0 | 0s | 0s | Cwd::::_perl_abs_pathCwd::_perl_abs_path
0 | 0 | 0 | 0s | 0s | Cwd::::_perl_getcwdCwd::_perl_getcwd
0 | 0 | 0 | 0s | 0s | Cwd::::_qnx_abs_pathCwd::_qnx_abs_path
0 | 0 | 0 | 0s | 0s | Cwd::::_qnx_cwdCwd::_qnx_cwd
0 | 0 | 0 | 0s | 0s | Cwd::::_vms_abs_pathCwd::_vms_abs_path
0 | 0 | 0 | 0s | 0s | Cwd::::_vms_cwdCwd::_vms_cwd
0 | 0 | 0 | 0s | 0s | Cwd::::_vms_efsCwd::_vms_efs
0 | 0 | 0 | 0s | 0s | Cwd::::_vms_unix_rptCwd::_vms_unix_rpt
0 | 0 | 0 | 0s | 0s | Cwd::::_win32_cwdCwd::_win32_cwd
0 | 0 | 0 | 0s | 0s | Cwd::::chdirCwd::chdir
0 | 0 | 0 | 0s | 0s | Cwd::::chdir_initCwd::chdir_init
0 | 0 | 0 | 0s | 0s | Cwd::::fast_abs_pathCwd::fast_abs_path
0 | 0 | 0 | 0s | 0s | Cwd::::fastcwd_Cwd::fastcwd_

Call graph for these subroutines as a Graphviz dot language file.

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package Cwd;
2 |  |  |  |  |
3 |  |  |  |  | =head1 NAME
4 |  |  |  |  |
5 |  |  |  |  | Cwd - get pathname of current working directory
6 |  |  |  |  |
7 |  |  |  |  | =head1 SYNOPSIS
8 |  |  |  |  |
9 |  |  |  |  | use Cwd;
10 |  |  |  |  | my $dir = getcwd;
11 |  |  |  |  |
12 |  |  |  |  | use Cwd 'abs_path';
13 |  |  |  |  | my $abs_path = abs_path($file);
14 |  |  |  |  |
15 |  |  |  |  | =head1 DESCRIPTION
16 |  |  |  |  |
17 |  |  |  |  | This module provides functions for determining the pathname of the
18 |  |  |  |  | current working directory. It is recommended that getcwd (or another
19 |  |  |  |  | *cwd() function) be used in I<all> code to ensure portability.
20 |  |  |  |  |
21 |  |  |  |  | By default, it exports the functions cwd(), getcwd(), fastcwd(), and
22 |  |  |  |  | fastgetcwd() (and, on Win32, getdcwd()) into the caller's namespace.
23 |  |  |  |  |
24 |  |  |  |  |
25 |  |  |  |  | =head2 getcwd and friends
26 |  |  |  |  |
27 |  |  |  |  | Each of these functions are called without arguments and return the
28 |  |  |  |  | absolute path of the current working directory.
29 |  |  |  |  |
30 |  |  |  |  | =over 4
31 |  |  |  |  |
32 |  |  |  |  | =item getcwd
33 |  |  |  |  |
34 |  |  |  |  | my $cwd = getcwd();
35 |  |  |  |  |
36 |  |  |  |  | Returns the current working directory.
37 |  |  |  |  |
38 |  |  |  |  | Exposes the POSIX function getcwd(3) or re-implements it if it's not
39 |  |  |  |  | available.
40 |  |  |  |  |
41 |  |  |  |  | =item cwd
42 |  |  |  |  |
43 |  |  |  |  | my $cwd = cwd();
44 |  |  |  |  |
45 |  |  |  |  | The cwd() is the most natural form for the current architecture. For
46 |  |  |  |  | most systems it is identical to `pwd` (but without the trailing line
47 |  |  |  |  | terminator).
48 |  |  |  |  |
49 |  |  |  |  | =item fastcwd
50 |  |  |  |  |
51 |  |  |  |  | my $cwd = fastcwd();
52 |  |  |  |  |
53 |  |  |  |  | A more dangerous version of getcwd(), but potentially faster.
54 |  |  |  |  |
55 |  |  |  |  | It might conceivably chdir() you out of a directory that it can't
56 |  |  |  |  | chdir() you back into. If fastcwd encounters a problem it will return
57 |  |  |  |  | undef but will probably leave you in a different directory. For a
58 |  |  |  |  | measure of extra security, if everything appears to have worked, the
59 |  |  |  |  | fastcwd() function will check that it leaves you in the same directory
60 |  |  |  |  | that it started in. If it has changed it will C<die> with the message
61 |  |  |  |  | "Unstable directory path, current directory changed
62 |  |  |  |  | unexpectedly". That should never happen.
63 |  |  |  |  |
64 |  |  |  |  | =item fastgetcwd
65 |  |  |  |  |
66 |  |  |  |  | my $cwd = fastgetcwd();
67 |  |  |  |  |
68 |  |  |  |  | The fastgetcwd() function is provided as a synonym for cwd().
69 |  |  |  |  |
70 |  |  |  |  | =item getdcwd
71 |  |  |  |  |
72 |  |  |  |  | my $cwd = getdcwd();
73 |  |  |  |  | my $cwd = getdcwd('C:');
74 |  |  |  |  |
75 |  |  |  |  | The getdcwd() function is also provided on Win32 to get the current working
76 |  |  |  |  | directory on the specified drive, since Windows maintains a separate current
77 |  |  |  |  | working directory for each drive. If no drive is specified then the current
78 |  |  |  |  | drive is assumed.
79 |  |  |  |  |
80 |  |  |  |  | This function simply calls the Microsoft C library _getdcwd() function.
81 |  |  |  |  |
82 |  |  |  |  | =back
83 |  |  |  |  |
84 |  |  |  |  |
85 |  |  |  |  | =head2 abs_path and friends
86 |  |  |  |  |
87 |  |  |  |  | These functions are exported only on request. They each take a single
88 |  |  |  |  | argument and return the absolute pathname for it. If no argument is
89 |  |  |  |  | given they'll use the current working directory.
90 |  |  |  |  |
91 |  |  |  |  | =over 4
92 |  |  |  |  |
93 |  |  |  |  | =item abs_path
94 |  |  |  |  |
95 |  |  |  |  | my $abs_path = abs_path($file);
96 |  |  |  |  |
97 |  |  |  |  | Uses the same algorithm as getcwd(). Symbolic links and relative-path
98 |  |  |  |  | components ("." and "..") are resolved to return the canonical
99 |  |  |  |  | pathname, just like realpath(3).
100 |  |  |  |  |
101 |  |  |  |  | =item realpath
102 |  |  |  |  |
103 |  |  |  |  | my $abs_path = realpath($file);
104 |  |  |  |  |
105 |  |  |  |  | A synonym for abs_path().
106 |  |  |  |  |
107 |  |  |  |  | =item fast_abs_path
108 |  |  |  |  |
109 |  |  |  |  | my $abs_path = fast_abs_path($file);
110 |  |  |  |  |
111 |  |  |  |  | A more dangerous, but potentially faster version of abs_path.
112 |  |  |  |  |
113 |  |  |  |  | =back
114 |  |  |  |  |
115 |  |  |  |  | =head2 $ENV{PWD}
116 |  |  |  |  |
117 |  |  |  |  | If you ask to override your chdir() built-in function,
118 |  |  |  |  |
119 |  |  |  |  | use Cwd qw(chdir);
120 |  |  |  |  |
121 |  |  |  |  | then your PWD environment variable will be kept up to date. Note that
122 |  |  |  |  | it will only be kept up to date if all packages which use chdir import
123 |  |  |  |  | it from Cwd.
124 |  |  |  |  |
125 |  |  |  |  |
126 |  |  |  |  | =head1 NOTES
127 |  |  |  |  |
128 |  |  |  |  | =over 4
129 |  |  |  |  |
130 |  |  |  |  | =item *
131 |  |  |  |  |
132 |  |  |  |  | Since the path seperators are different on some operating systems ('/'
133 |  |  |  |  | on Unix, ':' on MacPerl, etc...) we recommend you use the File::Spec
134 |  |  |  |  | modules wherever portability is a concern.
135 |  |  |  |  |
136 |  |  |  |  | =item *
137 |  |  |  |  |
138 |  |  |  |  | Actually, on Mac OS, the C<getcwd()>, C<fastgetcwd()> and C<fastcwd()>
139 |  |  |  |  | functions are all aliases for the C<cwd()> function, which, on Mac OS,
140 |  |  |  |  | calls `pwd`. Likewise, the C<abs_path()> function is an alias for
141 |  |  |  |  | C<fast_abs_path()>.
142 |  |  |  |  |
143 |  |  |  |  | =back
144 |  |  |  |  |
145 |  |  |  |  | =head1 AUTHOR
146 |  |  |  |  |
147 |  |  |  |  | Originally by the perl5-porters.
148 |  |  |  |  |
149 |  |  |  |  | Maintained by Ken Williams <KWILLIAMS@cpan.org>
150 |  |  |  |  |
151 |  |  |  |  | =head1 COPYRIGHT
152 |  |  |  |  |
153 |  |  |  |  | Copyright (c) 2004 by the Perl 5 Porters. All rights reserved.
154 |  |  |  |  |
155 |  |  |  |  | This program is free software; you can redistribute it and/or modify
156 |  |  |  |  | it under the same terms as Perl itself.
157 |  |  |  |  |
158 |  |  |  |  | Portions of the C code in this library are copyright (c) 1994 by the
159 |  |  |  |  | Regents of the University of California. All rights reserved. The
160 |  |  |  |  | license on this code is compatible with the licensing of the rest of
161 |  |  |  |  | the distribution - please see the source code in F<Cwd.xs> for the
162 |  |  |  |  | details.
163 |  |  |  |  |
164 |  |  |  |  | =head1 SEE ALSO
165 |  |  |  |  |
166 |  |  |  |  | L<File::chdir>
167 |  |  |  |  |
168 |  |  |  |  | =cut
169 |  |  |  |  |
170 | 3 | 32µs | 2 | 62µs | # spent 50µs (38+12) within Cwd::BEGIN@170 which was called # once (38µs+12µs) by Module::Find::BEGIN@8 at line 170 use strict; # spent 50µs making 1 call to Cwd::BEGIN@170 # spent 12µs making 1 call to strict::import
171 | 3 | 50µs | 2 | 128µs | # spent 78µs (28+50) within Cwd::BEGIN@171 which was called # once (28µs+50µs) by Module::Find::BEGIN@8 at line 171 use Exporter; # spent 78µs making 1 call to Cwd::BEGIN@171 # spent 50µs making 1 call to Exporter::import
172 | 3 | 308µs | 2 | 222µs | # spent 118µs (14+104) within Cwd::BEGIN@172 which was called # once (14µs+104µs) by Module::Find::BEGIN@8 at line 172 use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); # spent 118µs making 1 call to Cwd::BEGIN@172 # spent 104µs making 1 call to vars::import
173 |  |  |  |  |
174 | 1 | 1µs |  |  | $VERSION = '3.30';
175 | 1 | 300ns |  |  | my $xs_version = $VERSION;
176 | 1 | 20µs |  |  | $VERSION = eval $VERSION;
177 |  |  |  |  |
178 | 1 | 12µs |  |  | @ISA = qw/ Exporter /;
179 | 1 | 1µs |  |  | @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
180 | 1 | 1µs |  |  | push @EXPORT, qw(getdcwd) if $^O eq 'MSWin32';
181 | 1 | 1µs |  |  | @EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
182 |  |  |  |  |
183 |  |  |  |  | # sys_cwd may keep the builtin command
184 |  |  |  |  |
185 |  |  |  |  | # All the functionality of this module may provided by builtins,
186 |  |  |  |  | # there is no sense to process the rest of the file.
187 |  |  |  |  | # The best choice may be to have this in BEGIN, but how to return from BEGIN?
188 |  |  |  |  |
189 | 1 | 200ns |  |  | if ($^O eq 'os2') {
190 |  |  |  |  | local $^W = 0;
191 |  |  |  |  |
192 |  |  |  |  | *cwd = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
193 |  |  |  |  | *getcwd = \&cwd;
194 |  |  |  |  | *fastgetcwd = \&cwd;
195 |  |  |  |  | *fastcwd = \&cwd;
196 |  |  |  |  |
197 |  |  |  |  | *fast_abs_path = \&sys_abspath if defined &sys_abspath;
198 |  |  |  |  | *abs_path = \&fast_abs_path;
199 |  |  |  |  | *realpath = \&fast_abs_path;
200 |  |  |  |  | *fast_realpath = \&fast_abs_path;
201 |  |  |  |  |
202 |  |  |  |  | return 1;
203 |  |  |  |  | }
204 |  |  |  |  |
205 |  |  |  |  | # Need to look up the feature settings on VMS. The preferred way is to use the
206 |  |  |  |  | # VMS::Feature module, but that may not be available to dual life modules.
207 |  |  |  |  |
208 | 1 | 100ns |  |  | my $use_vms_feature;
209 |  |  |  |  | # spent 11µs within Cwd::BEGIN@209 which was called # once (11µs+0s) by Module::Find::BEGIN@8 at line 215 BEGIN {
210 | 1 | 12µs |  |  | if ($^O eq 'VMS') {
211 |  |  |  |  | if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
212 |  |  |  |  | $use_vms_feature = 1;
213 |  |  |  |  | }
214 |  |  |  |  | }
215 | 1 | 2.44ms | 1 | 11µs | } # spent 11µs making 1 call to Cwd::BEGIN@209
216 |  |  |  |  |
217 |  |  |  |  | # Need to look up the UNIX report mode. This may become a dynamic mode
218 |  |  |  |  | # in the future.
219 |  |  |  |  | sub _vms_unix_rpt {
220 |  |  |  |  | my $unix_rpt;
221 |  |  |  |  | if ($use_vms_feature) {
222 |  |  |  |  | $unix_rpt = VMS::Feature::current("filename_unix_report");
223 |  |  |  |  | } else {
224 |  |  |  |  | my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
225 |  |  |  |  | $unix_rpt = $env_unix_rpt =~ /^[ET1]/i;
226 |  |  |  |  | }
227 |  |  |  |  | return $unix_rpt;
228 |  |  |  |  | }
229 |  |  |  |  |
230 |  |  |  |  | # Need to look up the EFS character set mode. This may become a dynamic
231 |  |  |  |  | # mode in the future.
232 |  |  |  |  | sub _vms_efs {
233 |  |  |  |  | my $efs;
234 |  |  |  |  | if ($use_vms_feature) {
235 |  |  |  |  | $efs = VMS::Feature::current("efs_charset");
236 |  |  |  |  | } else {
237 |  |  |  |  | my $env_efs = $ENV{'DECC$EFS_CHARSET'} || '';
238 |  |  |  |  | $efs = $env_efs =~ /^[ET1]/i;
239 |  |  |  |  | }
240 |  |  |  |  | return $efs;
241 |  |  |  |  | }
242 |  |  |  |  |
243 |  |  |  |  |
244 |  |  |  |  | # If loading the XS stuff doesn't work, we can fall back to pure perl
245 | 1 | 500ns |  |  | eval {
246 | 1 | 3µs |  |  | if ( $] >= 5.006 ) {
247 | 1 | 600ns |  |  | require XSLoader;
248 | 1 | 293µs | 1 | 286µs | XSLoader::load( __PACKAGE__, $xs_version); # spent 286µs making 1 call to XSLoader::load
249 |  |  |  |  | } else {
250 |  |  |  |  | require DynaLoader;
251 |  |  |  |  | push @ISA, 'DynaLoader';
252 |  |  |  |  | __PACKAGE__->bootstrap( $xs_version );
253 |  |  |  |  | }
254 |  |  |  |  | };
255 |  |  |  |  |
256 |  |  |  |  | # Must be after the DynaLoader stuff:
257 | 1 | 31µs |  |  | $VERSION = eval $VERSION;
258 |  |  |  |  |
259 |  |  |  |  | # Big nasty table of function aliases
260 | 1 | 17µs |  |  | my %METHOD_MAP =
261 |  |  |  |  | (
262 |  |  |  |  | VMS =>
263 |  |  |  |  | {
264 |  |  |  |  | cwd => '_vms_cwd',
265 |  |  |  |  | getcwd => '_vms_cwd',
266 |  |  |  |  | fastcwd => '_vms_cwd',
267 |  |  |  |  | fastgetcwd => '_vms_cwd',
268 |  |  |  |  | abs_path => '_vms_abs_path',
269 |  |  |  |  | fast_abs_path => '_vms_abs_path',
270 |  |  |  |  | },
271 |  |  |  |  |
272 |  |  |  |  | MSWin32 =>
273 |  |  |  |  | {
274 |  |  |  |  | # We assume that &_NT_cwd is defined as an XSUB or in the core.
275 |  |  |  |  | cwd => '_NT_cwd',
276 |  |  |  |  | getcwd => '_NT_cwd',
277 |  |  |  |  | fastcwd => '_NT_cwd',
278 |  |  |  |  | fastgetcwd => '_NT_cwd',
279 |  |  |  |  | abs_path => 'fast_abs_path',
280 |  |  |  |  | realpath => 'fast_abs_path',
281 |  |  |  |  | },
282 |  |  |  |  |
283 |  |  |  |  | dos =>
284 |  |  |  |  | {
285 |  |  |  |  | cwd => '_dos_cwd',
286 |  |  |  |  | getcwd => '_dos_cwd',
287 |  |  |  |  | fastgetcwd => '_dos_cwd',
288 |  |  |  |  | fastcwd => '_dos_cwd',
289 |  |  |  |  | abs_path => 'fast_abs_path',
290 |  |  |  |  | },
291 |  |  |  |  |
292 |  |  |  |  | # QNX4. QNX6 has a $os of 'nto'.
293 |  |  |  |  | qnx =>
294 |  |  |  |  | {
295 |  |  |  |  | cwd => '_qnx_cwd',
296 |  |  |  |  | getcwd => '_qnx_cwd',
297 |  |  |  |  | fastgetcwd => '_qnx_cwd',
298 |  |  |  |  | fastcwd => '_qnx_cwd',
299 |  |  |  |  | abs_path => '_qnx_abs_path',
300 |  |  |  |  | fast_abs_path => '_qnx_abs_path',
301 |  |  |  |  | },
302 |  |  |  |  |
303 |  |  |  |  | cygwin =>
304 |  |  |  |  | {
305 |  |  |  |  | getcwd => 'cwd',
306 |  |  |  |  | fastgetcwd => 'cwd',
307 |  |  |  |  | fastcwd => 'cwd',
308 |  |  |  |  | abs_path => 'fast_abs_path',
309 |  |  |  |  | realpath => 'fast_abs_path',
310 |  |  |  |  | },
311 |  |  |  |  |
312 |  |  |  |  | epoc =>
313 |  |  |  |  | {
314 |  |  |  |  | cwd => '_epoc_cwd',
315 |  |  |  |  | getcwd => '_epoc_cwd',
316 |  |  |  |  | fastgetcwd => '_epoc_cwd',
317 |  |  |  |  | fastcwd => '_epoc_cwd',
318 |  |  |  |  | abs_path => 'fast_abs_path',
319 |  |  |  |  | },
320 |  |  |  |  |
321 |  |  |  |  | MacOS =>
322 |  |  |  |  | {
323 |  |  |  |  | getcwd => 'cwd',
324 |  |  |  |  | fastgetcwd => 'cwd',
325 |  |  |  |  | fastcwd => 'cwd',
326 |  |  |  |  | abs_path => 'fast_abs_path',
327 |  |  |  |  | },
328 |  |  |  |  | );
329 |  |  |  |  |
330 | 1 | 600ns |  |  | $METHOD_MAP{NT} = $METHOD_MAP{MSWin32};
331 |  |  |  |  |
332 |  |  |  |  |
333 |  |  |  |  | # Find the pwd command in the expected locations. We assume these
334 |  |  |  |  | # are safe. This prevents _backtick_pwd() consulting $ENV{PATH}
335 |  |  |  |  | # so everything works under taint mode.
336 | 1 | 100ns |  |  | my $pwd_cmd;
337 | 1 | 900ns |  |  | foreach my $try ('/bin/pwd',
338 |  |  |  |  | '/usr/bin/pwd',
339 |  |  |  |  | '/QOpenSys/bin/pwd', # OS/400 PASE.
340 |  |  |  |  | ) {
341 |  |  |  |  |
342 | 1 | 24µs | 1 | 15µs | if( -x $try ) { # spent 15µs making 1 call to Cwd::CORE:fteexec
343 | 1 | 400ns |  |  | $pwd_cmd = $try;
344 | 1 | 2µs |  |  | last;
345 |  |  |  |  | }
346 |  |  |  |  | }
347 | 1 | 500ns |  |  | my $found_pwd_cmd = defined($pwd_cmd);
348 | 1 | 100ns |  |  | unless ($pwd_cmd) {
349 |  |  |  |  | # Isn't this wrong? _backtick_pwd() will fail if somenone has
350 |  |  |  |  | # pwd in their path but it is not /bin/pwd or /usr/bin/pwd?
351 |  |  |  |  | # See [perl #16774]. --jhi
352 |  |  |  |  | $pwd_cmd = 'pwd';
353 |  |  |  |  | }
354 |  |  |  |  |
355 |  |  |  |  | # Lazy-load Carp
356 |  |  |  |  | sub _carp { require Carp; Carp::carp(@_) }
357 |  |  |  |  | sub _croak { require Carp; Carp::croak(@_) }
358 |  |  |  |  |
359 |  |  |  |  | # The 'natural and safe form' for UNIX (pwd may be setuid root)
360 |  |  |  |  | sub _backtick_pwd {
361 |  |  |  |  | # Localize %ENV entries in a way that won't create new hash keys
362 |  |  |  |  | my @localize = grep exists $ENV{$_}, qw(PATH IFS CDPATH ENV BASH_ENV);
363 |  |  |  |  | local @ENV{@localize};
364 |  |  |  |  |
365 |  |  |  |  | my $cwd = `$pwd_cmd`;
366 |  |  |  |  | # Belt-and-suspenders in case someone said "undef $/".
367 |  |  |  |  | local $/ = "\n";
368 |  |  |  |  | # `pwd` may fail e.g. if the disk is full
369 |  |  |  |  | chomp($cwd) if defined $cwd;
370 |  |  |  |  | $cwd;
371 |  |  |  |  | }
372 |  |  |  |  |
373 |  |  |  |  | # Since some ports may predefine cwd internally (e.g., NT)
374 |  |  |  |  | # we take care not to override an existing definition for cwd().
375 |  |  |  |  |
376 | 1 | 2µs |  |  | unless ($METHOD_MAP{$^O}{cwd} or defined &cwd) {
377 |  |  |  |  | # The pwd command is not available in some chroot(2)'ed environments
378 | 1 | 10µs | 1 | 6µs | my $sep = $Config::Config{path_sep} || ':'; # spent 6µs making 1 call to Config::FETCH
379 | 1 | 500ns |  |  | my $os = $^O; # Protect $^O from tainting
380 |  |  |  |  |
381 |  |  |  |  |
382 |  |  |  |  | # Try again to find a pwd, this time searching the whole PATH.
383 | 1 | 1µs |  |  | if (defined $ENV{PATH} and $os ne 'MSWin32') { # no pwd on Windows
384 | 1 | 17µs | 1 | 7µs | my @candidates = split($sep, $ENV{PATH}); # spent 7µs making 1 call to Cwd::CORE:regcomp
385 | 1 | 2µs |  |  | while (!$found_pwd_cmd and @candidates) {
386 |  |  |  |  | my $candidate = shift @candidates;
387 |  |  |  |  | $found_pwd_cmd = 1 if -x "$candidate/pwd";
388 |  |  |  |  | }
389 |  |  |  |  | }
390 |  |  |  |  |
391 |  |  |  |  | # MacOS has some special magic to make `pwd` work.
392 | 1 | 2µs |  |  | if( $os eq 'MacOS' || $found_pwd_cmd )
393 |  |  |  |  | {
394 |  |  |  |  | *cwd = \&_backtick_pwd;
395 |  |  |  |  | }
396 |  |  |  |  | else {
397 |  |  |  |  | *cwd = \&getcwd;
398 |  |  |  |  | }
399 |  |  |  |  | }
400 |  |  |  |  |
401 | 1 | 500ns |  |  | if ($^O eq 'cygwin') {
402 |  |  |  |  | # We need to make sure cwd() is called with no args, because it's
403 |  |  |  |  | # got an arg-less prototype and will die if args are present.
404 |  |  |  |  | local $^W = 0;
405 |  |  |  |  | my $orig_cwd = \&cwd;
406 |  |  |  |  | *cwd = sub { &$orig_cwd() }
407 |  |  |  |  | }
408 |  |  |  |  |
409 |  |  |  |  |
410 |  |  |  |  | # set a reasonable (and very safe) default for fastgetcwd, in case it
411 |  |  |  |  | # isn't redefined later (20001212 rspier)
412 | 1 | 400ns |  |  | *fastgetcwd = \&cwd;
413 |  |  |  |  |
414 |  |  |  |  | # A non-XS version of getcwd() - also used to bootstrap the perl build
415 |  |  |  |  | # process, when miniperl is running and no XS loading happens.
416 |  |  |  |  | sub _perl_getcwd
417 |  |  |  |  | {
418 |  |  |  |  | abs_path('.');
419 |  |  |  |  | }
420 |  |  |  |  |
421 |  |  |  |  | # By John Bazik
422 |  |  |  |  | #
423 |  |  |  |  | # Usage: $cwd = &fastcwd;
424 |  |  |  |  | #
425 |  |  |  |  | # This is a faster version of getcwd. It's also more dangerous because
426 |  |  |  |  | # you might chdir out of a directory that you can't chdir back into.
427 |  |  |  |  |
428 |  |  |  |  | sub fastcwd_ {
429 |  |  |  |  | my($odev, $oino, $cdev, $cino, $tdev, $tino);
430 |  |  |  |  | my(@path, $path);
431 |  |  |  |  | local(*DIR);
432 |  |  |  |  |
433 |  |  |  |  | my($orig_cdev, $orig_cino) = stat('.');
434 |  |  |  |  | ($cdev, $cino) = ($orig_cdev, $orig_cino);
435 |  |  |  |  | for (;;) {
436 |  |  |  |  | my $direntry;
437 |  |  |  |  | ($odev, $oino) = ($cdev, $cino);
438 |  |  |  |  | CORE::chdir('..') || return undef;
439 |  |  |  |  | ($cdev, $cino) = stat('.');
440 |  |  |  |  | last if $odev == $cdev && $oino == $cino;
441 |  |  |  |  | opendir(DIR, '.') || return undef;
442 |  |  |  |  | for (;;) {
443 |  |  |  |  | $direntry = readdir(DIR);
444 |  |  |  |  | last unless defined $direntry;
445 |  |  |  |  | next if $direntry eq '.';
446 |  |  |  |  | next if $direntry eq '..';
447 |  |  |  |  |
448 |  |  |  |  | ($tdev, $tino) = lstat($direntry);
449 |  |  |  |  | last unless $tdev != $odev || $tino != $oino;
450 |  |  |  |  | }
451 |  |  |  |  | closedir(DIR);
452 |  |  |  |  | return undef unless defined $direntry; # should never happen
453 |  |  |  |  | unshift(@path, $direntry);
454 |  |  |  |  | }
455 |  |  |  |  | $path = '/' . join('/', @path);
456 |  |  |  |  | if ($^O eq 'apollo') { $path = "/".$path; }
457 |  |  |  |  | # At this point $path may be tainted (if tainting) and chdir would fail.
458 |  |  |  |  | # Untaint it then check that we landed where we started.
459 |  |  |  |  | $path =~ /^(.*)\z/s # untaint
460 |  |  |  |  | && CORE::chdir($1) or return undef;
461 |  |  |  |  | ($cdev, $cino) = stat('.');
462 |  |  |  |  | die "Unstable directory path, current directory changed unexpectedly"
463 |  |  |  |  | if $cdev != $orig_cdev || $cino != $orig_cino;
464 |  |  |  |  | $path;
465 |  |  |  |  | }
466 | 1 | 300ns |  |  | if (not defined &fastcwd) { *fastcwd = \&fastcwd_ }
467 |  |  |  |  |
468 |  |  |  |  |
469 |  |  |  |  | # Keeps track of current working directory in PWD environment var
470 |  |  |  |  | # Usage:
471 |  |  |  |  | # use Cwd 'chdir';
472 |  |  |  |  | # chdir $newdir;
473 |  |  |  |  |
474 | 1 | 200ns |  |  | my $chdir_init = 0;
475 |  |  |  |  |
476 |  |  |  |  | sub chdir_init {
477 |  |  |  |  | if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos' and $^O ne 'MSWin32') {
478 |  |  |  |  | my($dd,$di) = stat('.');
479 |  |  |  |  | my($pd,$pi) = stat($ENV{'PWD'});
480 |  |  |  |  | if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
481 |  |  |  |  | $ENV{'PWD'} = cwd();
482 |  |  |  |  | }
483 |  |  |  |  | }
484 |  |  |  |  | else {
485 |  |  |  |  | my $wd = cwd();
486 |  |  |  |  | $wd = Win32::GetFullPathName($wd) if $^O eq 'MSWin32';
487 |  |  |  |  | $ENV{'PWD'} = $wd;
488 |  |  |  |  | }
489 |  |  |  |  | # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
490 |  |  |  |  | if ($^O ne 'MSWin32' and $ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|s) {
491 |  |  |  |  | my($pd,$pi) = stat($2);
492 |  |  |  |  | my($dd,$di) = stat($1);
493 |  |  |  |  | if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
494 |  |  |  |  | $ENV{'PWD'}="$2$3";
495 |  |  |  |  | }
496 |  |  |  |  | }
497 |  |  |  |  | $chdir_init = 1;
498 |  |  |  |  | }
499 |  |  |  |  |
500 |  |  |  |  | sub chdir {
501 |  |  |  |  | my $newdir = @_ ? shift : ''; # allow for no arg (chdir to HOME dir)
502 |  |  |  |  | $newdir =~ s|///*|/|g unless $^O eq 'MSWin32';
503 |  |  |  |  | chdir_init() unless $chdir_init;
504 |  |  |  |  | my $newpwd;
505 |  |  |  |  | if ($^O eq 'MSWin32') {
506 |  |  |  |  | # get the full path name *before* the chdir()
507 |  |  |  |  | $newpwd = Win32::GetFullPathName($newdir);
508 |  |  |  |  | }
509 |  |  |  |  |
510 |  |  |  |  | return 0 unless CORE::chdir $newdir;
511 |  |  |  |  |
512 |  |  |  |  | if ($^O eq 'VMS') {
513 |  |  |  |  | return $ENV{'PWD'} = $ENV{'DEFAULT'}
514 |  |  |  |  | }
515 |  |  |  |  | elsif ($^O eq 'MacOS') {
516 |  |  |  |  | return $ENV{'PWD'} = cwd();
517 |  |  |  |  | }
518 |  |  |  |  | elsif ($^O eq 'MSWin32') {
519 |  |  |  |  | $ENV{'PWD'} = $newpwd;
520 |  |  |  |  | return 1;
521 |  |  |  |  | }
522 |  |  |  |  |
523 |  |  |  |  | if (ref $newdir eq 'GLOB') { # in case a file/dir handle is passed in
524 |  |  |  |  | $ENV{'PWD'} = cwd();
525 |  |  |  |  | } elsif ($newdir =~ m#^/#s) {
526 |  |  |  |  | $ENV{'PWD'} = $newdir;
527 |  |  |  |  | } else {
528 |  |  |  |  | my @curdir = split(m#/#,$ENV{'PWD'});
529 |  |  |  |  | @curdir = ('') unless @curdir;
530 |  |  |  |  | my $component;
531 |  |  |  |  | foreach $component (split(m#/#, $newdir)) {
532 |  |  |  |  | next if $component eq '.';
533 |  |  |  |  | pop(@curdir),next if $component eq '..';
534 |  |  |  |  | push(@curdir,$component);
535 |  |  |  |  | }
536 |  |  |  |  | $ENV{'PWD'} = join('/',@curdir) || '/';
537 |  |  |  |  | }
538 |  |  |  |  | 1;
539 |  |  |  |  | }
540 |  |  |  |  |
541 |  |  |  |  |
542 |  |  |  |  | sub _perl_abs_path
543 |  |  |  |  | {
544 |  |  |  |  | my $start = @_ ? shift : '.';
545 |  |  |  |  | my($dotdots, $cwd, @pst, @cst, $dir, @tst);
546 |  |  |  |  |
547 |  |  |  |  | unless (@cst = stat( $start ))
548 |  |  |  |  | {
549 |  |  |  |  | _carp("stat($start): $!");
550 |  |  |  |  | return '';
551 |  |  |  |  | }
552 |  |  |  |  |
553 |  |  |  |  | unless (-d _) {
554 |  |  |  |  | # Make sure we can be invoked on plain files, not just directories.
555 |  |  |  |  | # NOTE that this routine assumes that '/' is the only directory separator.
556 |  |  |  |  |
557 |  |  |  |  | my ($dir, $file) = $start =~ m{^(.*)/(.+)$}
558 |  |  |  |  | or return cwd() . '/' . $start;
559 |  |  |  |  |
560 |  |  |  |  | # Can't use "-l _" here, because the previous stat was a stat(), not an lstat().
561 |  |  |  |  | if (-l $start) {
562 |  |  |  |  | my $link_target = readlink($start);
563 |  |  |  |  | die "Can't resolve link $start: $!" unless defined $link_target;
564 |  |  |  |  |
565 |  |  |  |  | require File::Spec;
566 |  |  |  |  | $link_target = $dir . '/' . $link_target
567 |  |  |  |  | unless File::Spec->file_name_is_absolute($link_target);
568 |  |  |  |  |
569 |  |  |  |  | return abs_path($link_target);
570 |  |  |  |  | }
571 |  |  |  |  |
572 |  |  |  |  | return $dir ? abs_path($dir) . "/$file" : "/$file";
573 |  |  |  |  | }
574 |  |  |  |  |
575 |  |  |  |  | $cwd = '';
576 |  |  |  |  | $dotdots = $start;
577 |  |  |  |  | do
578 |  |  |  |  | {
579 |  |  |  |  | $dotdots .= '/..';
580 |  |  |  |  | @pst = @cst;
581 |  |  |  |  | local *PARENT;
582 |  |  |  |  | unless (opendir(PARENT, $dotdots))
583 |  |  |  |  | {
584 |  |  |  |  | # probably a permissions issue. Try the native command.
585 |  |  |  |  | return File::Spec->rel2abs( $start, _backtick_pwd() );
586 |  |  |  |  | }
587 |  |  |  |  | unless (@cst = stat($dotdots))
588 |  |  |  |  | {
589 |  |  |  |  | _carp("stat($dotdots): $!");
590 |  |  |  |  | closedir(PARENT);
591 |  |  |  |  | return '';
592 |  |  |  |  | }
593 |  |  |  |  | if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
594 |  |  |  |  | {
595 |  |  |  |  | $dir = undef;
596 |  |  |  |  | }
597 |  |  |  |  | else
598 |  |  |  |  | {
599 |  |  |  |  | do
600 |  |  |  |  | {
601 |  |  |  |  | unless (defined ($dir = readdir(PARENT)))
602 |  |  |  |  | {
603 |  |  |  |  | _carp("readdir($dotdots): $!");
604 |  |  |  |  | closedir(PARENT);
605 |  |  |  |  | return '';
606 |  |  |  |  | }
607 |  |  |  |  | $tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir"))
608 |  |  |  |  | }
609 |  |  |  |  | while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
610 |  |  |  |  | $tst[1] != $pst[1]);
611 |  |  |  |  | }
612 |  |  |  |  | $cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ;
613 |  |  |  |  | closedir(PARENT);
614 |  |  |  |  | } while (defined $dir);
615 |  |  |  |  | chop($cwd) unless $cwd eq '/'; # drop the trailing /
616 |  |  |  |  | $cwd;
617 |  |  |  |  | }
618 |  |  |  |  |
619 |  |  |  |  |
620 | 1 | 100ns |  |  | my $Curdir;
621 |  |  |  |  | sub fast_abs_path {
622 |  |  |  |  | local $ENV{PWD} = $ENV{PWD} || ''; # Guard against clobberage
623 |  |  |  |  | my $cwd = getcwd();
624 |  |  |  |  | require File::Spec;
625 |  |  |  |  | my $path = @_ ? shift : ($Curdir ||= File::Spec->curdir);
626 |  |  |  |  |
627 |  |  |  |  | # Detaint else we'll explode in taint mode. This is safe because
628 |  |  |  |  | # we're not doing anything dangerous with it.
629 |  |  |  |  | ($path) = $path =~ /(.*)/;
630 |  |  |  |  | ($cwd) = $cwd =~ /(.*)/;
631 |  |  |  |  |
632 |  |  |  |  | unless (-e $path) {
633 |  |  |  |  | _croak("$path: No such file or directory");
634 |  |  |  |  | }
635 |  |  |  |  |
636 |  |  |  |  | unless (-d _) {
637 |  |  |  |  | # Make sure we can be invoked on plain files, not just directories.
638 |  |  |  |  |
639 |  |  |  |  | my ($vol, $dir, $file) = File::Spec->splitpath($path);
640 |  |  |  |  | return File::Spec->catfile($cwd, $path) unless length $dir;
641 |  |  |  |  |
642 |  |  |  |  | if (-l $path) {
643 |  |  |  |  | my $link_target = readlink($path);
644 |  |  |  |  | die "Can't resolve link $path: $!" unless defined $link_target;
645 |  |  |  |  |
646 |  |  |  |  | $link_target = File::Spec->catpath($vol, $dir, $link_target)
647 |  |  |  |  | unless File::Spec->file_name_is_absolute($link_target);
648 |  |  |  |  |
649 |  |  |  |  | return fast_abs_path($link_target);
650 |  |  |  |  | }
651 |  |  |  |  |
652 |  |  |  |  | return $dir eq File::Spec->rootdir
653 |  |  |  |  | ? File::Spec->catpath($vol, $dir, $file)
654 |  |  |  |  | : fast_abs_path(File::Spec->catpath($vol, $dir, '')) . '/' . $file;
655 |  |  |  |  | }
656 |  |  |  |  |
657 |  |  |  |  | if (!CORE::chdir($path)) {
658 |  |  |  |  | _croak("Cannot chdir to $path: $!");
659 |  |  |  |  | }
660 |  |  |  |  | my $realpath = getcwd();
661 |  |  |  |  | if (! ((-d $cwd) && (CORE::chdir($cwd)))) {
662 |  |  |  |  | _croak("Cannot chdir back to $cwd: $!");
663 |  |  |  |  | }
664 |  |  |  |  | $realpath;
665 |  |  |  |  | }
666 |  |  |  |  |
667 |  |  |  |  | # added function alias to follow principle of least surprise
668 |  |  |  |  | # based on previous aliasing. --tchrist 27-Jan-00
669 | 1 | 300ns |  |  | *fast_realpath = \&fast_abs_path;
670 |  |  |  |  |
671 |  |  |  |  |
672 |  |  |  |  | # --- PORTING SECTION ---
673 |  |  |  |  |
674 |  |  |  |  | # VMS: $ENV{'DEFAULT'} points to default directory at all times
675 |  |  |  |  | # 06-Mar-1996 Charles Bailey bailey@newman.upenn.edu
676 |  |  |  |  | # Note: Use of Cwd::chdir() causes the logical name PWD to be defined
677 |  |  |  |  | # in the process logical name table as the default device and directory
678 |  |  |  |  | # seen by Perl. This may not be the same as the default device
679 |  |  |  |  | # and directory seen by DCL after Perl exits, since the effects
680 |  |  |  |  | # the CRTL chdir() function persist only until Perl exits.
681 |  |  |  |  |
682 |  |  |  |  | sub _vms_cwd {
683 |  |  |  |  | return $ENV{'DEFAULT'};
684 |  |  |  |  | }
685 |  |  |  |  |
686 |  |  |  |  | sub _vms_abs_path {
687 |  |  |  |  | return $ENV{'DEFAULT'} unless @_;
688 |  |  |  |  | my $path = shift;
689 |  |  |  |  |
690 |  |  |  |  | my $efs = _vms_efs;
691 |  |  |  |  | my $unix_rpt = _vms_unix_rpt;
692 |  |  |  |  |
693 |  |  |  |  | if (defined &VMS::Filespec::vmsrealpath) {
694 |  |  |  |  | my $path_unix = 0;
695 |  |  |  |  | my $path_vms = 0;
696 |  |  |  |  |
697 |  |  |  |  | $path_unix = 1 if ($path =~ m#(?<=\^)/#);
698 |  |  |  |  | $path_unix = 1 if ($path =~ /^\.\.?$/);
699 |  |  |  |  | $path_vms = 1 if ($path =~ m#[\[<\]]#);
700 |  |  |  |  | $path_vms = 1 if ($path =~ /^--?$/);
701 |  |  |  |  |
702 |  |  |  |  | my $unix_mode = $path_unix;
703 |  |  |  |  | if ($efs) {
704 |  |  |  |  | # In case of a tie, the Unix report mode decides.
705 |  |  |  |  | if ($path_vms == $path_unix) {
706 |  |  |  |  | $unix_mode = $unix_rpt;
707 |  |  |  |  | } else {
708 |  |  |  |  | $unix_mode = 0 if $path_vms;
709 |  |  |  |  | }
710 |  |  |  |  | }
711 |  |  |  |  |
712 |  |  |  |  | if ($unix_mode) {
713 |  |  |  |  | # Unix format
714 |  |  |  |  | return VMS::Filespec::unixrealpath($path);
715 |  |  |  |  | }
716 |  |  |  |  |
717 |  |  |  |  | # VMS format
718 |  |  |  |  |
719 |  |  |  |  | my $new_path = VMS::Filespec::vmsrealpath($path);
720 |  |  |  |  |
721 |  |  |  |  | # Perl expects directories to be in directory format
722 |  |  |  |  | $new_path = VMS::Filespec::pathify($new_path) if -d $path;
723 |  |  |  |  | return $new_path;
724 |  |  |  |  | }
725 |  |  |  |  |
726 |  |  |  |  | # Fallback to older algorithm if correct ones are not
727 |  |  |  |  | # available.
728 |  |  |  |  |
729 |  |  |  |  | if (-l $path) {
730 |  |  |  |  | my $link_target = readlink($path);
731 |  |  |  |  | die "Can't resolve link $path: $!" unless defined $link_target;
732 |  |  |  |  |
733 |  |  |  |  | return _vms_abs_path($link_target);
734 |  |  |  |  | }
735 |  |  |  |  |
736 |  |  |  |  | # may need to turn foo.dir into [.foo]
737 |  |  |  |  | my $pathified = VMS::Filespec::pathify($path);
738 |  |  |  |  | $path = $pathified if defined $pathified;
739 |  |  |  |  |
740 |  |  |  |  | return VMS::Filespec::rmsexpand($path);
741 |  |  |  |  | }
742 |  |  |  |  |
743 |  |  |  |  | sub _os2_cwd {
744 |  |  |  |  | $ENV{'PWD'} = `cmd /c cd`;
745 |  |  |  |  | chomp $ENV{'PWD'};
746 |  |  |  |  | $ENV{'PWD'} =~ s:\\:/:g ;
747 |  |  |  |  | return $ENV{'PWD'};
748 |  |  |  |  | }
749 |  |  |  |  |
750 |  |  |  |  | sub _win32_cwd {
751 |  |  |  |  | if (defined &DynaLoader::boot_DynaLoader) {
752 |  |  |  |  | $ENV{'PWD'} = Win32::GetCwd();
753 |  |  |  |  | }
754 |  |  |  |  | else { # miniperl
755 |  |  |  |  | chomp($ENV{'PWD'} = `cd`);
756 |  |  |  |  | }
757 |  |  |  |  | $ENV{'PWD'} =~ s:\\:/:g ;
758 |  |  |  |  | return $ENV{'PWD'};
759 |  |  |  |  | }
760 |  |  |  |  |
761 | 1 | 500ns |  |  | *_NT_cwd = defined &Win32::GetCwd ? \&_win32_cwd : \&_os2_cwd;
762 |  |  |  |  |
763 |  |  |  |  | sub _dos_cwd {
764 |  |  |  |  | if (!defined &Dos::GetCwd) {
765 |  |  |  |  | $ENV{'PWD'} = `command /c cd`;
766 |  |  |  |  | chomp $ENV{'PWD'};
767 |  |  |  |  | $ENV{'PWD'} =~ s:\\:/:g ;
768 |  |  |  |  | } else {
769 |  |  |  |  | $ENV{'PWD'} = Dos::GetCwd();
770 |  |  |  |  | }
771 |  |  |  |  | return $ENV{'PWD'};
772 |  |  |  |  | }
773 |  |  |  |  |
774 |  |  |  |  | sub _qnx_cwd {
775 |  |  |  |  | local $ENV{PATH} = '';
776 |  |  |  |  | local $ENV{CDPATH} = '';
777 |  |  |  |  | local $ENV{ENV} = '';
778 |  |  |  |  | $ENV{'PWD'} = `/usr/bin/fullpath -t`;
779 |  |  |  |  | chomp $ENV{'PWD'};
780 |  |  |  |  | return $ENV{'PWD'};
781 |  |  |  |  | }
782 |  |  |  |  |
783 |  |  |  |  | sub _qnx_abs_path {
784 |  |  |  |  | local $ENV{PATH} = '';
785 |  |  |  |  | local $ENV{CDPATH} = '';
786 |  |  |  |  | local $ENV{ENV} = '';
787 |  |  |  |  | my $path = @_ ? shift : '.';
788 |  |  |  |  | local *REALPATH;
789 |  |  |  |  |
790 |  |  |  |  | defined( open(REALPATH, '-|') || exec '/usr/bin/fullpath', '-t', $path ) or
791 |  |  |  |  | die "Can't open /usr/bin/fullpath: $!";
792 |  |  |  |  | my $realpath = <REALPATH>;
793 |  |  |  |  | close REALPATH;
794 |  |  |  |  | chomp $realpath;
795 |  |  |  |  | return $realpath;
796 |  |  |  |  | }
797 |  |  |  |  |
798 |  |  |  |  | sub _epoc_cwd {
799 |  |  |  |  | $ENV{'PWD'} = EPOC::getcwd();
800 |  |  |  |  | return $ENV{'PWD'};
801 |  |  |  |  | }
802 |  |  |  |  |
803 |  |  |  |  |
804 |  |  |  |  | # Now that all the base-level functions are set up, alias the
805 |  |  |  |  | # user-level functions to the right places
806 |  |  |  |  |
807 | 1 | 700ns |  |  | if (exists $METHOD_MAP{$^O}) {
808 | 1 | 400ns |  |  | my $map = $METHOD_MAP{$^O};
809 | 1 | 2µs |  |  | foreach my $name (keys %$map) {
810 |  |  |  |  | local $^W = 0; # assignments trigger 'subroutine redefined' warning
811 | 3 | 136µs | 2 | 81µs | # spent 48µs (15+33) within Cwd::BEGIN@811 which was called # once (15µs+33µs) by Module::Find::BEGIN@8 at line 811 no strict 'refs'; # spent 48µs making 1 call to Cwd::BEGIN@811 # spent 33µs making 1 call to strict::unimport
812 |  |  |  |  | *{$name} = \&{$map->{$name}};
813 |  |  |  |  | }
814 |  |  |  |  | }
815 |  |  |  |  |
816 |  |  |  |  | # In case the XS version doesn't load.
817 | 1 | 200ns |  |  | *abs_path = \&_perl_abs_path unless defined &abs_path;
818 | 1 | 200ns |  |  | *getcwd = \&_perl_getcwd unless defined &getcwd;
819 |  |  |  |  |
820 |  |  |  |  | # added function alias for those of us more
821 |  |  |  |  | # used to the libc function. --tchrist 27-Jan-00
822 | 1 | 400ns |  |  | *realpath = \&abs_path;
823 |  |  |  |  |
824 | 1 | 127µs |  |  | 1;
|  |  |  |  | # spent 15µs within Cwd::CORE:fteexec which was called # once (15µs+0s) by Module::Find::BEGIN@8 at line 342 of Cwd.pm sub Cwd::CORE:fteexec; # xsub
|  |  |  |  | # spent 7µs within Cwd::CORE:regcomp which was called # once (7µs+0s) by Module::Find::BEGIN@8 at line 384 of Cwd.pm sub Cwd::CORE:regcomp; # xsub
|  |  |  |  | # spent 52µs within Cwd::getcwd which was called # once (52µs+0s) by File::Find::_find_opt at line 610 of File/Find.pm sub Cwd::getcwd; # xsub