← Index
NYTProf Performance Profile   « line view »
For split.pl
  Run on Thu Apr 20 02:05:47 2023
Reported on Thu Apr 20 18:31:09 2023

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