← Index
NYTProf Performance Profile   « line view »
For svc/members/upsert
  Run on Tue Jan 13 11:50:22 2015
Reported on Tue Jan 13 12:09:47 2015

Filename/usr/lib/x86_64-linux-gnu/perl/5.20/Cwd.pm
StatementsExecuted 50 statements in 2.60ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
2212.17ms2.17msCwd::::abs_pathCwd::abs_path (xsub)
11124µs24µsCwd::::bootstrapCwd::bootstrap (xsub)
11113µs24µsCwd::::BEGIN@3Cwd::BEGIN@3
11113µs22µsCwd::::BEGIN@667Cwd::BEGIN@667
11110µs10µsCwd::::getcwdCwd::getcwd (xsub)
11110µs10µsCwd::::CORE:fteexecCwd::CORE:fteexec (opcode)
1118µs46µsCwd::::BEGIN@5Cwd::BEGIN@5
1118µs23µsCwd::::BEGIN@4Cwd::BEGIN@4
1115µs5µsCwd::::CORE:regcompCwd::CORE:regcomp (opcode)
1114µs4µsCwd::::BEGIN@42Cwd::BEGIN@42
1111µs1µsCwd::::CORE:matchCwd::CORE:match (opcode)
0000s0sCwd::::__ANON__[:253]Cwd::__ANON__[:253]
0000s0sCwd::::_backtick_pwdCwd::_backtick_pwd
0000s0sCwd::::_carpCwd::_carp
0000s0sCwd::::_croakCwd::_croak
0000s0sCwd::::_dos_cwdCwd::_dos_cwd
0000s0sCwd::::_epoc_cwdCwd::_epoc_cwd
0000s0sCwd::::_os2_cwdCwd::_os2_cwd
0000s0sCwd::::_perl_abs_pathCwd::_perl_abs_path
0000s0sCwd::::_perl_getcwdCwd::_perl_getcwd
0000s0sCwd::::_qnx_abs_pathCwd::_qnx_abs_path
0000s0sCwd::::_qnx_cwdCwd::_qnx_cwd
0000s0sCwd::::_vms_abs_pathCwd::_vms_abs_path
0000s0sCwd::::_vms_cwdCwd::_vms_cwd
0000s0sCwd::::_vms_efsCwd::_vms_efs
0000s0sCwd::::_vms_unix_rptCwd::_vms_unix_rpt
0000s0sCwd::::_win32_cwdCwd::_win32_cwd
0000s0sCwd::::_win32_cwd_simpleCwd::_win32_cwd_simple
0000s0sCwd::::chdirCwd::chdir
0000s0sCwd::::chdir_initCwd::chdir_init
0000s0sCwd::::fast_abs_pathCwd::fast_abs_path
0000s0sCwd::::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
1package Cwd;
2
3225µs236µs
# spent 24µs (13+12) within Cwd::BEGIN@3 which was called: # once (13µs+12µs) by Module::Metadata::BEGIN@29 at line 3
use strict;
# spent 24µs making 1 call to Cwd::BEGIN@3 # spent 12µs making 1 call to strict::import
4225µs238µs
# spent 23µs (8+15) within Cwd::BEGIN@4 which was called: # once (8µs+15µs) by Module::Metadata::BEGIN@29 at line 4
use Exporter;
# spent 23µs making 1 call to Cwd::BEGIN@4 # spent 15µs making 1 call to Exporter::import
52188µs285µs
# spent 46µs (8+38) within Cwd::BEGIN@5 which was called: # once (8µs+38µs) by Module::Metadata::BEGIN@29 at line 5
use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
# spent 46µs making 1 call to Cwd::BEGIN@5 # spent 38µs making 1 call to vars::import
6
71500ns$VERSION = '3.48';
81200nsmy $xs_version = $VERSION;
91800ns$VERSION =~ tr/_//;
10
1118µs@ISA = qw/ Exporter /;
121700ns@EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
1311µspush @EXPORT, qw(getdcwd) if $^O eq 'MSWin32';
141700ns@EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
15
16# sys_cwd may keep the builtin command
17
18# All the functionality of this module may provided by builtins,
19# there is no sense to process the rest of the file.
20# The best choice may be to have this in BEGIN, but how to return from BEGIN?
21
221200nsif ($^O eq 'os2') {
23 local $^W = 0;
24
25 *cwd = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
26 *getcwd = \&cwd;
27 *fastgetcwd = \&cwd;
28 *fastcwd = \&cwd;
29
30 *fast_abs_path = \&sys_abspath if defined &sys_abspath;
31 *abs_path = \&fast_abs_path;
32 *realpath = \&fast_abs_path;
33 *fast_realpath = \&fast_abs_path;
34
35 return 1;
36}
37
38# Need to look up the feature settings on VMS. The preferred way is to use the
39# VMS::Feature module, but that may not be available to dual life modules.
40
411100nsmy $use_vms_feature;
42
# spent 4µs within Cwd::BEGIN@42 which was called: # once (4µs+0s) by Module::Metadata::BEGIN@29 at line 48
BEGIN {
4315µs if ($^O eq 'VMS') {
44 if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
45 $use_vms_feature = 1;
46 }
47 }
4812.16ms14µs}
# spent 4µs making 1 call to Cwd::BEGIN@42
49
50# Need to look up the UNIX report mode. This may become a dynamic mode
51# in the future.
52sub _vms_unix_rpt {
53 my $unix_rpt;
54 if ($use_vms_feature) {
55 $unix_rpt = VMS::Feature::current("filename_unix_report");
56 } else {
57 my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
58 $unix_rpt = $env_unix_rpt =~ /^[ET1]/i;
59 }
60 return $unix_rpt;
61}
62
63# Need to look up the EFS character set mode. This may become a dynamic
64# mode in the future.
65sub _vms_efs {
66 my $efs;
67 if ($use_vms_feature) {
68 $efs = VMS::Feature::current("efs_charset");
69 } else {
70 my $env_efs = $ENV{'DECC$EFS_CHARSET'} || '';
71 $efs = $env_efs =~ /^[ET1]/i;
72 }
73 return $efs;
74}
75
76# If loading the XS stuff doesn't work, we can fall back to pure perl
771500nsunless (defined &getcwd) {
78 eval {
79 if ( $] >= 5.006 ) {
80 require XSLoader;
81 XSLoader::load( __PACKAGE__, $xs_version);
82 } else {
83 require DynaLoader;
84 push @ISA, 'DynaLoader';
85 __PACKAGE__->bootstrap( $xs_version );
86 }
87 };
88}
89
90# Big nasty table of function aliases
9117µsmy %METHOD_MAP =
92 (
93 VMS =>
94 {
95 cwd => '_vms_cwd',
96 getcwd => '_vms_cwd',
97 fastcwd => '_vms_cwd',
98 fastgetcwd => '_vms_cwd',
99 abs_path => '_vms_abs_path',
100 fast_abs_path => '_vms_abs_path',
101 },
102
103 MSWin32 =>
104 {
105 # We assume that &_NT_cwd is defined as an XSUB or in the core.
106 cwd => '_NT_cwd',
107 getcwd => '_NT_cwd',
108 fastcwd => '_NT_cwd',
109 fastgetcwd => '_NT_cwd',
110 abs_path => 'fast_abs_path',
111 realpath => 'fast_abs_path',
112 },
113
114 dos =>
115 {
116 cwd => '_dos_cwd',
117 getcwd => '_dos_cwd',
118 fastgetcwd => '_dos_cwd',
119 fastcwd => '_dos_cwd',
120 abs_path => 'fast_abs_path',
121 },
122
123 # QNX4. QNX6 has a $os of 'nto'.
124 qnx =>
125 {
126 cwd => '_qnx_cwd',
127 getcwd => '_qnx_cwd',
128 fastgetcwd => '_qnx_cwd',
129 fastcwd => '_qnx_cwd',
130 abs_path => '_qnx_abs_path',
131 fast_abs_path => '_qnx_abs_path',
132 },
133
134 cygwin =>
135 {
136 getcwd => 'cwd',
137 fastgetcwd => 'cwd',
138 fastcwd => 'cwd',
139 abs_path => 'fast_abs_path',
140 realpath => 'fast_abs_path',
141 },
142
143 epoc =>
144 {
145 cwd => '_epoc_cwd',
146 getcwd => '_epoc_cwd',
147 fastgetcwd => '_epoc_cwd',
148 fastcwd => '_epoc_cwd',
149 abs_path => 'fast_abs_path',
150 },
151
152 MacOS =>
153 {
154 getcwd => 'cwd',
155 fastgetcwd => 'cwd',
156 fastcwd => 'cwd',
157 abs_path => 'fast_abs_path',
158 },
159 );
160
1611800ns$METHOD_MAP{NT} = $METHOD_MAP{MSWin32};
162
163# Find the pwd command in the expected locations. We assume these
164# are safe. This prevents _backtick_pwd() consulting $ENV{PATH}
165# so everything works under taint mode.
16610smy $pwd_cmd;
1671400nsforeach my $try ('/bin/pwd',
168 '/usr/bin/pwd',
169 '/QOpenSys/bin/pwd', # OS/400 PASE.
170 ) {
171
172115µs110µs if( -x $try ) {
# spent 10µs making 1 call to Cwd::CORE:fteexec
1731200ns $pwd_cmd = $try;
17411µs last;
175 }
176}
177
178# Android has a built-in pwd. Using $pwd_cmd will DTRT if
179# this perl was compiled with -Dd_useshellcmds, which is the
180# default for Android, but the block below is needed for the
181# miniperl running on the host when cross-compiling, and
182# potentially for native builds with -Ud_useshellcmds.
18315µs11µsif ($^O =~ /android/) {
# spent 1µs making 1 call to Cwd::CORE:match
184 # If targetsh is executable, then we're either a full
185 # perl, or a miniperl for a native build.
186 if (-x $Config::Config{targetsh}) {
187 $pwd_cmd = "$Config::Config{targetsh} -c pwd"
188 }
189 else {
190 my $sh = $Config::Config{sh} || (-x '/system/bin/sh' ? '/system/bin/sh' : 'sh');
191 $pwd_cmd = "$sh -c pwd"
192 }
193}
194
1951400nsmy $found_pwd_cmd = defined($pwd_cmd);
1961100nsunless ($pwd_cmd) {
197 # Isn't this wrong? _backtick_pwd() will fail if someone has
198 # pwd in their path but it is not /bin/pwd or /usr/bin/pwd?
199 # See [perl #16774]. --jhi
200 $pwd_cmd = 'pwd';
201}
202
203# Lazy-load Carp
204sub _carp { require Carp; Carp::carp(@_) }
205sub _croak { require Carp; Carp::croak(@_) }
206
207# The 'natural and safe form' for UNIX (pwd may be setuid root)
208sub _backtick_pwd {
209 # Localize %ENV entries in a way that won't create new hash keys
210 my @localize = grep exists $ENV{$_}, qw(PATH IFS CDPATH ENV BASH_ENV);
211 local @ENV{@localize};
212
213 my $cwd = `$pwd_cmd`;
214 # Belt-and-suspenders in case someone said "undef $/".
215 local $/ = "\n";
216 # `pwd` may fail e.g. if the disk is full
217 chomp($cwd) if defined $cwd;
218 $cwd;
219}
220
221# Since some ports may predefine cwd internally (e.g., NT)
222# we take care not to override an existing definition for cwd().
223
22411µsunless ($METHOD_MAP{$^O}{cwd} or defined &cwd) {
225 # The pwd command is not available in some chroot(2)'ed environments
22616µs14µs my $sep = $Config::Config{path_sep} || ':';
# spent 4µs making 1 call to Config::FETCH
2271500ns my $os = $^O; # Protect $^O from tainting
228
229 # Try again to find a pwd, this time searching the whole PATH.
2301900ns if (defined $ENV{PATH} and $os ne 'MSWin32') { # no pwd on Windows
231111µs15µs my @candidates = split($sep, $ENV{PATH});
# spent 5µs making 1 call to Cwd::CORE:regcomp
23211µs while (!$found_pwd_cmd and @candidates) {
233 my $candidate = shift @candidates;
234 $found_pwd_cmd = 1 if -x "$candidate/pwd";
235 }
236 }
237
238 # MacOS has some special magic to make `pwd` work.
23911µs if( $os eq 'MacOS' || $found_pwd_cmd )
240 {
241 *cwd = \&_backtick_pwd;
242 }
243 else {
244 *cwd = \&getcwd;
245 }
246}
247
2481500nsif ($^O eq 'cygwin') {
249 # We need to make sure cwd() is called with no args, because it's
250 # got an arg-less prototype and will die if args are present.
251 local $^W = 0;
252 my $orig_cwd = \&cwd;
253 *cwd = sub { &$orig_cwd() }
254}
255
256# set a reasonable (and very safe) default for fastgetcwd, in case it
257# isn't redefined later (20001212 rspier)
2581400ns*fastgetcwd = \&cwd;
259
260# A non-XS version of getcwd() - also used to bootstrap the perl build
261# process, when miniperl is running and no XS loading happens.
262sub _perl_getcwd
263{
264 abs_path('.');
265}
266
267# By John Bazik
268#
269# Usage: $cwd = &fastcwd;
270#
271# This is a faster version of getcwd. It's also more dangerous because
272# you might chdir out of a directory that you can't chdir back into.
273
274sub fastcwd_ {
275 my($odev, $oino, $cdev, $cino, $tdev, $tino);
276 my(@path, $path);
277 local(*DIR);
278
279 my($orig_cdev, $orig_cino) = stat('.');
280 ($cdev, $cino) = ($orig_cdev, $orig_cino);
281 for (;;) {
282 my $direntry;
283 ($odev, $oino) = ($cdev, $cino);
284 CORE::chdir('..') || return undef;
285 ($cdev, $cino) = stat('.');
286 last if $odev == $cdev && $oino == $cino;
287 opendir(DIR, '.') || return undef;
288 for (;;) {
289 $direntry = readdir(DIR);
290 last unless defined $direntry;
291 next if $direntry eq '.';
292 next if $direntry eq '..';
293
294 ($tdev, $tino) = lstat($direntry);
295 last unless $tdev != $odev || $tino != $oino;
296 }
297 closedir(DIR);
298 return undef unless defined $direntry; # should never happen
299 unshift(@path, $direntry);
300 }
301 $path = '/' . join('/', @path);
302 if ($^O eq 'apollo') { $path = "/".$path; }
303 # At this point $path may be tainted (if tainting) and chdir would fail.
304 # Untaint it then check that we landed where we started.
305 $path =~ /^(.*)\z/s # untaint
306 && CORE::chdir($1) or return undef;
307 ($cdev, $cino) = stat('.');
308 die "Unstable directory path, current directory changed unexpectedly"
309 if $cdev != $orig_cdev || $cino != $orig_cino;
310 $path;
311}
3121300nsif (not defined &fastcwd) { *fastcwd = \&fastcwd_ }
313
314# Keeps track of current working directory in PWD environment var
315# Usage:
316# use Cwd 'chdir';
317# chdir $newdir;
318
3191200nsmy $chdir_init = 0;
320
321sub chdir_init {
322 if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos' and $^O ne 'MSWin32') {
323 my($dd,$di) = stat('.');
324 my($pd,$pi) = stat($ENV{'PWD'});
325 if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
326 $ENV{'PWD'} = cwd();
327 }
328 }
329 else {
330 my $wd = cwd();
331 $wd = Win32::GetFullPathName($wd) if $^O eq 'MSWin32';
332 $ENV{'PWD'} = $wd;
333 }
334 # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
335 if ($^O ne 'MSWin32' and $ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|s) {
336 my($pd,$pi) = stat($2);
337 my($dd,$di) = stat($1);
338 if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
339 $ENV{'PWD'}="$2$3";
340 }
341 }
342 $chdir_init = 1;
343}
344
345sub chdir {
346 my $newdir = @_ ? shift : ''; # allow for no arg (chdir to HOME dir)
347 $newdir =~ s|///*|/|g unless $^O eq 'MSWin32';
348 chdir_init() unless $chdir_init;
349 my $newpwd;
350 if ($^O eq 'MSWin32') {
351 # get the full path name *before* the chdir()
352 $newpwd = Win32::GetFullPathName($newdir);
353 }
354
355 return 0 unless CORE::chdir $newdir;
356
357 if ($^O eq 'VMS') {
358 return $ENV{'PWD'} = $ENV{'DEFAULT'}
359 }
360 elsif ($^O eq 'MacOS') {
361 return $ENV{'PWD'} = cwd();
362 }
363 elsif ($^O eq 'MSWin32') {
364 $ENV{'PWD'} = $newpwd;
365 return 1;
366 }
367
368 if (ref $newdir eq 'GLOB') { # in case a file/dir handle is passed in
369 $ENV{'PWD'} = cwd();
370 } elsif ($newdir =~ m#^/#s) {
371 $ENV{'PWD'} = $newdir;
372 } else {
373 my @curdir = split(m#/#,$ENV{'PWD'});
374 @curdir = ('') unless @curdir;
375 my $component;
376 foreach $component (split(m#/#, $newdir)) {
377 next if $component eq '.';
378 pop(@curdir),next if $component eq '..';
379 push(@curdir,$component);
380 }
381 $ENV{'PWD'} = join('/',@curdir) || '/';
382 }
383 1;
384}
385
386sub _perl_abs_path
387{
388 my $start = @_ ? shift : '.';
389 my($dotdots, $cwd, @pst, @cst, $dir, @tst);
390
391 unless (@cst = stat( $start ))
392 {
393 _carp("stat($start): $!");
394 return '';
395 }
396
397 unless (-d _) {
398 # Make sure we can be invoked on plain files, not just directories.
399 # NOTE that this routine assumes that '/' is the only directory separator.
400
401 my ($dir, $file) = $start =~ m{^(.*)/(.+)$}
402 or return cwd() . '/' . $start;
403
404 # Can't use "-l _" here, because the previous stat was a stat(), not an lstat().
405 if (-l $start) {
406 my $link_target = readlink($start);
407 die "Can't resolve link $start: $!" unless defined $link_target;
408
409 require File::Spec;
410 $link_target = $dir . '/' . $link_target
411 unless File::Spec->file_name_is_absolute($link_target);
412
413 return abs_path($link_target);
414 }
415
416 return $dir ? abs_path($dir) . "/$file" : "/$file";
417 }
418
419 $cwd = '';
420 $dotdots = $start;
421 do
422 {
423 $dotdots .= '/..';
424 @pst = @cst;
425 local *PARENT;
426 unless (opendir(PARENT, $dotdots))
427 {
428 # probably a permissions issue. Try the native command.
429 require File::Spec;
430 return File::Spec->rel2abs( $start, _backtick_pwd() );
431 }
432 unless (@cst = stat($dotdots))
433 {
434 _carp("stat($dotdots): $!");
435 closedir(PARENT);
436 return '';
437 }
438 if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
439 {
440 $dir = undef;
441 }
442 else
443 {
444 do
445 {
446 unless (defined ($dir = readdir(PARENT)))
447 {
448 _carp("readdir($dotdots): $!");
449 closedir(PARENT);
450 return '';
451 }
452 $tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir"))
453 }
454 while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
455 $tst[1] != $pst[1]);
456 }
457 $cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ;
458 closedir(PARENT);
459 } while (defined $dir);
460 chop($cwd) unless $cwd eq '/'; # drop the trailing /
461 $cwd;
462}
463
4641100nsmy $Curdir;
465sub fast_abs_path {
466 local $ENV{PWD} = $ENV{PWD} || ''; # Guard against clobberage
467 my $cwd = getcwd();
468 require File::Spec;
469 my $path = @_ ? shift : ($Curdir ||= File::Spec->curdir);
470
471 # Detaint else we'll explode in taint mode. This is safe because
472 # we're not doing anything dangerous with it.
473 ($path) = $path =~ /(.*)/s;
474 ($cwd) = $cwd =~ /(.*)/s;
475
476 unless (-e $path) {
477 _croak("$path: No such file or directory");
478 }
479
480 unless (-d _) {
481 # Make sure we can be invoked on plain files, not just directories.
482
483 my ($vol, $dir, $file) = File::Spec->splitpath($path);
484 return File::Spec->catfile($cwd, $path) unless length $dir;
485
486 if (-l $path) {
487 my $link_target = readlink($path);
488 die "Can't resolve link $path: $!" unless defined $link_target;
489
490 $link_target = File::Spec->catpath($vol, $dir, $link_target)
491 unless File::Spec->file_name_is_absolute($link_target);
492
493 return fast_abs_path($link_target);
494 }
495
496 return $dir eq File::Spec->rootdir
497 ? File::Spec->catpath($vol, $dir, $file)
498 : fast_abs_path(File::Spec->catpath($vol, $dir, '')) . '/' . $file;
499 }
500
501 if (!CORE::chdir($path)) {
502 _croak("Cannot chdir to $path: $!");
503 }
504 my $realpath = getcwd();
505 if (! ((-d $cwd) && (CORE::chdir($cwd)))) {
506 _croak("Cannot chdir back to $cwd: $!");
507 }
508 $realpath;
509}
510
511# added function alias to follow principle of least surprise
512# based on previous aliasing. --tchrist 27-Jan-00
5131200ns*fast_realpath = \&fast_abs_path;
514
515# --- PORTING SECTION ---
516
517# VMS: $ENV{'DEFAULT'} points to default directory at all times
518# 06-Mar-1996 Charles Bailey bailey@newman.upenn.edu
519# Note: Use of Cwd::chdir() causes the logical name PWD to be defined
520# in the process logical name table as the default device and directory
521# seen by Perl. This may not be the same as the default device
522# and directory seen by DCL after Perl exits, since the effects
523# the CRTL chdir() function persist only until Perl exits.
524
525sub _vms_cwd {
526 return $ENV{'DEFAULT'};
527}
528
529sub _vms_abs_path {
530 return $ENV{'DEFAULT'} unless @_;
531 my $path = shift;
532
533 my $efs = _vms_efs;
534 my $unix_rpt = _vms_unix_rpt;
535
536 if (defined &VMS::Filespec::vmsrealpath) {
537 my $path_unix = 0;
538 my $path_vms = 0;
539
540 $path_unix = 1 if ($path =~ m#(?<=\^)/#);
541 $path_unix = 1 if ($path =~ /^\.\.?$/);
542 $path_vms = 1 if ($path =~ m#[\[<\]]#);
543 $path_vms = 1 if ($path =~ /^--?$/);
544
545 my $unix_mode = $path_unix;
546 if ($efs) {
547 # In case of a tie, the Unix report mode decides.
548 if ($path_vms == $path_unix) {
549 $unix_mode = $unix_rpt;
550 } else {
551 $unix_mode = 0 if $path_vms;
552 }
553 }
554
555 if ($unix_mode) {
556 # Unix format
557 return VMS::Filespec::unixrealpath($path);
558 }
559
560 # VMS format
561
562 my $new_path = VMS::Filespec::vmsrealpath($path);
563
564 # Perl expects directories to be in directory format
565 $new_path = VMS::Filespec::pathify($new_path) if -d $path;
566 return $new_path;
567 }
568
569 # Fallback to older algorithm if correct ones are not
570 # available.
571
572 if (-l $path) {
573 my $link_target = readlink($path);
574 die "Can't resolve link $path: $!" unless defined $link_target;
575
576 return _vms_abs_path($link_target);
577 }
578
579 # may need to turn foo.dir into [.foo]
580 my $pathified = VMS::Filespec::pathify($path);
581 $path = $pathified if defined $pathified;
582
583 return VMS::Filespec::rmsexpand($path);
584}
585
586sub _os2_cwd {
587 $ENV{'PWD'} = `cmd /c cd`;
588 chomp $ENV{'PWD'};
589 $ENV{'PWD'} =~ s:\\:/:g ;
590 return $ENV{'PWD'};
591}
592
593sub _win32_cwd_simple {
594 $ENV{'PWD'} = `cd`;
595 chomp $ENV{'PWD'};
596 $ENV{'PWD'} =~ s:\\:/:g ;
597 return $ENV{'PWD'};
598}
599
600sub _win32_cwd {
601 # Need to avoid taking any sort of reference to the typeglob or the code in
602 # the optree, so that this tests the runtime state of things, as the
603 # ExtUtils::MakeMaker tests for "miniperl" need to be able to fake things at
604 # runtime by deleting the subroutine. *foo{THING} syntax on a symbol table
605 # lookup avoids needing a string eval, which has been reported to cause
606 # problems (for reasons that we haven't been able to get to the bottom of -
607 # rt.cpan.org #56225)
608 if (*{$DynaLoader::{boot_DynaLoader}}{CODE}) {
609 $ENV{'PWD'} = Win32::GetCwd();
610 }
611 else { # miniperl
612 chomp($ENV{'PWD'} = `cd`);
613 }
614 $ENV{'PWD'} =~ s:\\:/:g ;
615 return $ENV{'PWD'};
616}
617
6181400ns*_NT_cwd = defined &Win32::GetCwd ? \&_win32_cwd : \&_win32_cwd_simple;
619
620sub _dos_cwd {
621 if (!defined &Dos::GetCwd) {
622 $ENV{'PWD'} = `command /c cd`;
623 chomp $ENV{'PWD'};
624 $ENV{'PWD'} =~ s:\\:/:g ;
625 } else {
626 $ENV{'PWD'} = Dos::GetCwd();
627 }
628 return $ENV{'PWD'};
629}
630
631sub _qnx_cwd {
632 local $ENV{PATH} = '';
633 local $ENV{CDPATH} = '';
634 local $ENV{ENV} = '';
635 $ENV{'PWD'} = `/usr/bin/fullpath -t`;
636 chomp $ENV{'PWD'};
637 return $ENV{'PWD'};
638}
639
640sub _qnx_abs_path {
641 local $ENV{PATH} = '';
642 local $ENV{CDPATH} = '';
643 local $ENV{ENV} = '';
644 my $path = @_ ? shift : '.';
645 local *REALPATH;
646
647 defined( open(REALPATH, '-|') || exec '/usr/bin/fullpath', '-t', $path ) or
648 die "Can't open /usr/bin/fullpath: $!";
649 my $realpath = <REALPATH>;
650 close REALPATH;
651 chomp $realpath;
652 return $realpath;
653}
654
655sub _epoc_cwd {
656 $ENV{'PWD'} = EPOC::getcwd();
657 return $ENV{'PWD'};
658}
659
660# Now that all the base-level functions are set up, alias the
661# user-level functions to the right places
662
6631600nsif (exists $METHOD_MAP{$^O}) {
6641400ns my $map = $METHOD_MAP{$^O};
66511µs foreach my $name (keys %$map) {
666 local $^W = 0; # assignments trigger 'subroutine redefined' warning
667297µs232µs
# spent 22µs (13+10) within Cwd::BEGIN@667 which was called: # once (13µs+10µs) by Module::Metadata::BEGIN@29 at line 667
no strict 'refs';
# spent 22µs making 1 call to Cwd::BEGIN@667 # spent 10µs making 1 call to strict::unimport
668 *{$name} = \&{$map->{$name}};
669 }
670}
671
672# In case the XS version doesn't load.
6731300ns*abs_path = \&_perl_abs_path unless defined &abs_path;
6741100ns*getcwd = \&_perl_getcwd unless defined &getcwd;
675
676# added function alias for those of us more
677# used to the libc function. --tchrist 27-Jan-00
6781200ns*realpath = \&abs_path;
679
680132µs1;
 
# spent 10µs within Cwd::CORE:fteexec which was called: # once (10µs+0s) by Module::Metadata::BEGIN@29 at line 172
sub Cwd::CORE:fteexec; # opcode
# spent 1µs within Cwd::CORE:match which was called: # once (1µs+0s) by Module::Metadata::BEGIN@29 at line 183
sub Cwd::CORE:match; # opcode
# spent 5µs within Cwd::CORE:regcomp which was called: # once (5µs+0s) by Module::Metadata::BEGIN@29 at line 231
sub Cwd::CORE:regcomp; # opcode
# spent 2.17ms within Cwd::abs_path which was called 2 times, avg 1.09ms/call: # once (1.13ms+0s) by FindBin::init at line 158 of FindBin.pm # once (1.04ms+0s) by FindBin::init at line 161 of FindBin.pm
sub Cwd::abs_path; # xsub
# spent 24µs within Cwd::bootstrap which was called: # once (24µs+0s) by DynaLoader::bootstrap at line 210 of DynaLoader.pm
sub Cwd::bootstrap; # xsub
# spent 10µs within Cwd::getcwd which was called: # once (10µs+0s) by FindBin::cwd2 at line 101 of FindBin.pm
sub Cwd::getcwd; # xsub
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.