← Index
NYTProf Performance Profile   « line view »
For rbm/rbm
  Run on Wed Feb 12 03:38:15 2020
Reported on Wed Feb 12 04:56:35 2020

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