← Index
NYTProf Performance Profile   « line view »
For flows_to_es.pl
  Run on Mon May 9 23:27:59 2016
Reported on Mon May 9 23:28:08 2016

Filename/usr/lib/perl/5.18/Cwd.pm
StatementsExecuted 52 statements in 4.47ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
111714µs736µsCwd::::BEGIN@4Cwd::BEGIN@4
11112µs25µsCwd::::BEGIN@3Cwd::BEGIN@3
11110µs24µsCwd::::BEGIN@647Cwd::BEGIN@647
1118µs60µsCwd::::BEGIN@5Cwd::BEGIN@5
1116µs6µsCwd::::CORE:fteexecCwd::CORE:fteexec (opcode)
1116µs6µsCwd::::CORE:regcompCwd::CORE:regcomp (opcode)
1115µs5µsCwd::::BEGIN@42Cwd::BEGIN@42
0000s0sCwd::::__ANON__[:233]Cwd::__ANON__[:233]
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
3226µs238µs
# spent 25µs (12+13) within Cwd::BEGIN@3 which was called: # once (12µs+13µs) by File::Path::BEGIN@6 at line 3
use strict;
# spent 25µs making 1 call to Cwd::BEGIN@3 # spent 13µs making 1 call to strict::import
42730µs2757µs
# spent 736µs (714+21) within Cwd::BEGIN@4 which was called: # once (714µs+21µs) by File::Path::BEGIN@6 at line 4
use Exporter;
# spent 736µs making 1 call to Cwd::BEGIN@4 # spent 21µs making 1 call to Exporter::import
52212µs2112µs
# spent 60µs (8+52) within Cwd::BEGIN@5 which was called: # once (8µs+52µs) by File::Path::BEGIN@6 at line 5
use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
# spent 60µs making 1 call to Cwd::BEGIN@5 # spent 52µs making 1 call to vars::import
6
71700ns$VERSION = '3.40';
81300nsmy $xs_version = $VERSION;
91600ns$VERSION =~ tr/_//;
10
1117µs@ISA = qw/ Exporter /;
1211µs@EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
131900nspush @EXPORT, qw(getdcwd) if $^O eq 'MSWin32';
141900ns@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 5µs within Cwd::BEGIN@42 which was called: # once (5µs+0s) by File::Path::BEGIN@6 at line 48
BEGIN {
4319µs if ($^O eq 'VMS') {
44 if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
45 $use_vms_feature = 1;
46 }
47 }
4813.12ms15µs}
# spent 5µ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
7712µseval {
7811µs if ( $] >= 5.006 ) {
791300ns require XSLoader;
801119µs1112µs XSLoader::load( __PACKAGE__, $xs_version);
# spent 112µs making 1 call to XSLoader::load
81 } else {
82 require DynaLoader;
83 push @ISA, 'DynaLoader';
84 __PACKAGE__->bootstrap( $xs_version );
85 }
86};
87
88# Big nasty table of function aliases
89113µsmy %METHOD_MAP =
90 (
91 VMS =>
92 {
93 cwd => '_vms_cwd',
94 getcwd => '_vms_cwd',
95 fastcwd => '_vms_cwd',
96 fastgetcwd => '_vms_cwd',
97 abs_path => '_vms_abs_path',
98 fast_abs_path => '_vms_abs_path',
99 },
100
101 MSWin32 =>
102 {
103 # We assume that &_NT_cwd is defined as an XSUB or in the core.
104 cwd => '_NT_cwd',
105 getcwd => '_NT_cwd',
106 fastcwd => '_NT_cwd',
107 fastgetcwd => '_NT_cwd',
108 abs_path => 'fast_abs_path',
109 realpath => 'fast_abs_path',
110 },
111
112 dos =>
113 {
114 cwd => '_dos_cwd',
115 getcwd => '_dos_cwd',
116 fastgetcwd => '_dos_cwd',
117 fastcwd => '_dos_cwd',
118 abs_path => 'fast_abs_path',
119 },
120
121 # QNX4. QNX6 has a $os of 'nto'.
122 qnx =>
123 {
124 cwd => '_qnx_cwd',
125 getcwd => '_qnx_cwd',
126 fastgetcwd => '_qnx_cwd',
127 fastcwd => '_qnx_cwd',
128 abs_path => '_qnx_abs_path',
129 fast_abs_path => '_qnx_abs_path',
130 },
131
132 cygwin =>
133 {
134 getcwd => 'cwd',
135 fastgetcwd => 'cwd',
136 fastcwd => 'cwd',
137 abs_path => 'fast_abs_path',
138 realpath => 'fast_abs_path',
139 },
140
141 epoc =>
142 {
143 cwd => '_epoc_cwd',
144 getcwd => '_epoc_cwd',
145 fastgetcwd => '_epoc_cwd',
146 fastcwd => '_epoc_cwd',
147 abs_path => 'fast_abs_path',
148 },
149
150 MacOS =>
151 {
152 getcwd => 'cwd',
153 fastgetcwd => 'cwd',
154 fastcwd => 'cwd',
155 abs_path => 'fast_abs_path',
156 },
157 );
158
15911µs$METHOD_MAP{NT} = $METHOD_MAP{MSWin32};
160
161# Find the pwd command in the expected locations. We assume these
162# are safe. This prevents _backtick_pwd() consulting $ENV{PATH}
163# so everything works under taint mode.
1641100nsmy $pwd_cmd;
1651700nsforeach my $try ('/bin/pwd',
166 '/usr/bin/pwd',
167 '/QOpenSys/bin/pwd', # OS/400 PASE.
168 ) {
169
170111µs16µs if( -x $try ) {
# spent 6µs making 1 call to Cwd::CORE:fteexec
1711400ns $pwd_cmd = $try;
17211µs last;
173 }
174}
1751500nsmy $found_pwd_cmd = defined($pwd_cmd);
1761200nsunless ($pwd_cmd) {
177 # Isn't this wrong? _backtick_pwd() will fail if somenone has
178 # pwd in their path but it is not /bin/pwd or /usr/bin/pwd?
179 # See [perl #16774]. --jhi
180 $pwd_cmd = 'pwd';
181}
182
183# Lazy-load Carp
184sub _carp { require Carp; Carp::carp(@_) }
185sub _croak { require Carp; Carp::croak(@_) }
186
187# The 'natural and safe form' for UNIX (pwd may be setuid root)
188sub _backtick_pwd {
189 # Localize %ENV entries in a way that won't create new hash keys
190 my @localize = grep exists $ENV{$_}, qw(PATH IFS CDPATH ENV BASH_ENV);
191 local @ENV{@localize};
192
193 my $cwd = `$pwd_cmd`;
194 # Belt-and-suspenders in case someone said "undef $/".
195 local $/ = "\n";
196 # `pwd` may fail e.g. if the disk is full
197 chomp($cwd) if defined $cwd;
198 $cwd;
199}
200
201# Since some ports may predefine cwd internally (e.g., NT)
202# we take care not to override an existing definition for cwd().
203
20412µsunless ($METHOD_MAP{$^O}{cwd} or defined &cwd) {
205 # The pwd command is not available in some chroot(2)'ed environments
2061500ns my $sep = $Config::Config{path_sep} || ':';
2071600ns my $os = $^O; # Protect $^O from tainting
208
209 # Try again to find a pwd, this time searching the whole PATH.
2101900ns if (defined $ENV{PATH} and $os ne 'MSWin32') { # no pwd on Windows
211113µs16µs my @candidates = split($sep, $ENV{PATH});
# spent 6µs making 1 call to Cwd::CORE:regcomp
21212µs while (!$found_pwd_cmd and @candidates) {
213 my $candidate = shift @candidates;
214 $found_pwd_cmd = 1 if -x "$candidate/pwd";
215 }
216 }
217
218 # MacOS has some special magic to make `pwd` work.
21912µs if( $os eq 'MacOS' || $found_pwd_cmd )
220 {
221 *cwd = \&_backtick_pwd;
222 }
223 else {
224 *cwd = \&getcwd;
225 }
226}
227
2281700nsif ($^O eq 'cygwin') {
229 # We need to make sure cwd() is called with no args, because it's
230 # got an arg-less prototype and will die if args are present.
231 local $^W = 0;
232 my $orig_cwd = \&cwd;
233 *cwd = sub { &$orig_cwd() }
234}
235
236# set a reasonable (and very safe) default for fastgetcwd, in case it
237# isn't redefined later (20001212 rspier)
2381600ns*fastgetcwd = \&cwd;
239
240# A non-XS version of getcwd() - also used to bootstrap the perl build
241# process, when miniperl is running and no XS loading happens.
242sub _perl_getcwd
243{
244 abs_path('.');
245}
246
247# By John Bazik
248#
249# Usage: $cwd = &fastcwd;
250#
251# This is a faster version of getcwd. It's also more dangerous because
252# you might chdir out of a directory that you can't chdir back into.
253
254sub fastcwd_ {
255 my($odev, $oino, $cdev, $cino, $tdev, $tino);
256 my(@path, $path);
257 local(*DIR);
258
259 my($orig_cdev, $orig_cino) = stat('.');
260 ($cdev, $cino) = ($orig_cdev, $orig_cino);
261 for (;;) {
262 my $direntry;
263 ($odev, $oino) = ($cdev, $cino);
264 CORE::chdir('..') || return undef;
265 ($cdev, $cino) = stat('.');
266 last if $odev == $cdev && $oino == $cino;
267 opendir(DIR, '.') || return undef;
268 for (;;) {
269 $direntry = readdir(DIR);
270 last unless defined $direntry;
271 next if $direntry eq '.';
272 next if $direntry eq '..';
273
274 ($tdev, $tino) = lstat($direntry);
275 last unless $tdev != $odev || $tino != $oino;
276 }
277 closedir(DIR);
278 return undef unless defined $direntry; # should never happen
279 unshift(@path, $direntry);
280 }
281 $path = '/' . join('/', @path);
282 if ($^O eq 'apollo') { $path = "/".$path; }
283 # At this point $path may be tainted (if tainting) and chdir would fail.
284 # Untaint it then check that we landed where we started.
285 $path =~ /^(.*)\z/s # untaint
286 && CORE::chdir($1) or return undef;
287 ($cdev, $cino) = stat('.');
288 die "Unstable directory path, current directory changed unexpectedly"
289 if $cdev != $orig_cdev || $cino != $orig_cino;
290 $path;
291}
2921300nsif (not defined &fastcwd) { *fastcwd = \&fastcwd_ }
293
294# Keeps track of current working directory in PWD environment var
295# Usage:
296# use Cwd 'chdir';
297# chdir $newdir;
298
2991200nsmy $chdir_init = 0;
300
301sub chdir_init {
302 if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos' and $^O ne 'MSWin32') {
303 my($dd,$di) = stat('.');
304 my($pd,$pi) = stat($ENV{'PWD'});
305 if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
306 $ENV{'PWD'} = cwd();
307 }
308 }
309 else {
310 my $wd = cwd();
311 $wd = Win32::GetFullPathName($wd) if $^O eq 'MSWin32';
312 $ENV{'PWD'} = $wd;
313 }
314 # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
315 if ($^O ne 'MSWin32' and $ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|s) {
316 my($pd,$pi) = stat($2);
317 my($dd,$di) = stat($1);
318 if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
319 $ENV{'PWD'}="$2$3";
320 }
321 }
322 $chdir_init = 1;
323}
324
325sub chdir {
326 my $newdir = @_ ? shift : ''; # allow for no arg (chdir to HOME dir)
327 $newdir =~ s|///*|/|g unless $^O eq 'MSWin32';
328 chdir_init() unless $chdir_init;
329 my $newpwd;
330 if ($^O eq 'MSWin32') {
331 # get the full path name *before* the chdir()
332 $newpwd = Win32::GetFullPathName($newdir);
333 }
334
335 return 0 unless CORE::chdir $newdir;
336
337 if ($^O eq 'VMS') {
338 return $ENV{'PWD'} = $ENV{'DEFAULT'}
339 }
340 elsif ($^O eq 'MacOS') {
341 return $ENV{'PWD'} = cwd();
342 }
343 elsif ($^O eq 'MSWin32') {
344 $ENV{'PWD'} = $newpwd;
345 return 1;
346 }
347
348 if (ref $newdir eq 'GLOB') { # in case a file/dir handle is passed in
349 $ENV{'PWD'} = cwd();
350 } elsif ($newdir =~ m#^/#s) {
351 $ENV{'PWD'} = $newdir;
352 } else {
353 my @curdir = split(m#/#,$ENV{'PWD'});
354 @curdir = ('') unless @curdir;
355 my $component;
356 foreach $component (split(m#/#, $newdir)) {
357 next if $component eq '.';
358 pop(@curdir),next if $component eq '..';
359 push(@curdir,$component);
360 }
361 $ENV{'PWD'} = join('/',@curdir) || '/';
362 }
363 1;
364}
365
366sub _perl_abs_path
367{
368 my $start = @_ ? shift : '.';
369 my($dotdots, $cwd, @pst, @cst, $dir, @tst);
370
371 unless (@cst = stat( $start ))
372 {
373 _carp("stat($start): $!");
374 return '';
375 }
376
377 unless (-d _) {
378 # Make sure we can be invoked on plain files, not just directories.
379 # NOTE that this routine assumes that '/' is the only directory separator.
380
381 my ($dir, $file) = $start =~ m{^(.*)/(.+)$}
382 or return cwd() . '/' . $start;
383
384 # Can't use "-l _" here, because the previous stat was a stat(), not an lstat().
385 if (-l $start) {
386 my $link_target = readlink($start);
387 die "Can't resolve link $start: $!" unless defined $link_target;
388
389 require File::Spec;
390 $link_target = $dir . '/' . $link_target
391 unless File::Spec->file_name_is_absolute($link_target);
392
393 return abs_path($link_target);
394 }
395
396 return $dir ? abs_path($dir) . "/$file" : "/$file";
397 }
398
399 $cwd = '';
400 $dotdots = $start;
401 do
402 {
403 $dotdots .= '/..';
404 @pst = @cst;
405 local *PARENT;
406 unless (opendir(PARENT, $dotdots))
407 {
408 # probably a permissions issue. Try the native command.
409 require File::Spec;
410 return File::Spec->rel2abs( $start, _backtick_pwd() );
411 }
412 unless (@cst = stat($dotdots))
413 {
414 _carp("stat($dotdots): $!");
415 closedir(PARENT);
416 return '';
417 }
418 if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
419 {
420 $dir = undef;
421 }
422 else
423 {
424 do
425 {
426 unless (defined ($dir = readdir(PARENT)))
427 {
428 _carp("readdir($dotdots): $!");
429 closedir(PARENT);
430 return '';
431 }
432 $tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir"))
433 }
434 while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
435 $tst[1] != $pst[1]);
436 }
437 $cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ;
438 closedir(PARENT);
439 } while (defined $dir);
440 chop($cwd) unless $cwd eq '/'; # drop the trailing /
441 $cwd;
442}
443
4441100nsmy $Curdir;
445sub fast_abs_path {
446 local $ENV{PWD} = $ENV{PWD} || ''; # Guard against clobberage
447 my $cwd = getcwd();
448 require File::Spec;
449 my $path = @_ ? shift : ($Curdir ||= File::Spec->curdir);
450
451 # Detaint else we'll explode in taint mode. This is safe because
452 # we're not doing anything dangerous with it.
453 ($path) = $path =~ /(.*)/s;
454 ($cwd) = $cwd =~ /(.*)/s;
455
456 unless (-e $path) {
457 _croak("$path: No such file or directory");
458 }
459
460 unless (-d _) {
461 # Make sure we can be invoked on plain files, not just directories.
462
463 my ($vol, $dir, $file) = File::Spec->splitpath($path);
464 return File::Spec->catfile($cwd, $path) unless length $dir;
465
466 if (-l $path) {
467 my $link_target = readlink($path);
468 die "Can't resolve link $path: $!" unless defined $link_target;
469
470 $link_target = File::Spec->catpath($vol, $dir, $link_target)
471 unless File::Spec->file_name_is_absolute($link_target);
472
473 return fast_abs_path($link_target);
474 }
475
476 return $dir eq File::Spec->rootdir
477 ? File::Spec->catpath($vol, $dir, $file)
478 : fast_abs_path(File::Spec->catpath($vol, $dir, '')) . '/' . $file;
479 }
480
481 if (!CORE::chdir($path)) {
482 _croak("Cannot chdir to $path: $!");
483 }
484 my $realpath = getcwd();
485 if (! ((-d $cwd) && (CORE::chdir($cwd)))) {
486 _croak("Cannot chdir back to $cwd: $!");
487 }
488 $realpath;
489}
490
491# added function alias to follow principle of least surprise
492# based on previous aliasing. --tchrist 27-Jan-00
4931400ns*fast_realpath = \&fast_abs_path;
494
495# --- PORTING SECTION ---
496
497# VMS: $ENV{'DEFAULT'} points to default directory at all times
498# 06-Mar-1996 Charles Bailey bailey@newman.upenn.edu
499# Note: Use of Cwd::chdir() causes the logical name PWD to be defined
500# in the process logical name table as the default device and directory
501# seen by Perl. This may not be the same as the default device
502# and directory seen by DCL after Perl exits, since the effects
503# the CRTL chdir() function persist only until Perl exits.
504
505sub _vms_cwd {
506 return $ENV{'DEFAULT'};
507}
508
509sub _vms_abs_path {
510 return $ENV{'DEFAULT'} unless @_;
511 my $path = shift;
512
513 my $efs = _vms_efs;
514 my $unix_rpt = _vms_unix_rpt;
515
516 if (defined &VMS::Filespec::vmsrealpath) {
517 my $path_unix = 0;
518 my $path_vms = 0;
519
520 $path_unix = 1 if ($path =~ m#(?<=\^)/#);
521 $path_unix = 1 if ($path =~ /^\.\.?$/);
522 $path_vms = 1 if ($path =~ m#[\[<\]]#);
523 $path_vms = 1 if ($path =~ /^--?$/);
524
525 my $unix_mode = $path_unix;
526 if ($efs) {
527 # In case of a tie, the Unix report mode decides.
528 if ($path_vms == $path_unix) {
529 $unix_mode = $unix_rpt;
530 } else {
531 $unix_mode = 0 if $path_vms;
532 }
533 }
534
535 if ($unix_mode) {
536 # Unix format
537 return VMS::Filespec::unixrealpath($path);
538 }
539
540 # VMS format
541
542 my $new_path = VMS::Filespec::vmsrealpath($path);
543
544 # Perl expects directories to be in directory format
545 $new_path = VMS::Filespec::pathify($new_path) if -d $path;
546 return $new_path;
547 }
548
549 # Fallback to older algorithm if correct ones are not
550 # available.
551
552 if (-l $path) {
553 my $link_target = readlink($path);
554 die "Can't resolve link $path: $!" unless defined $link_target;
555
556 return _vms_abs_path($link_target);
557 }
558
559 # may need to turn foo.dir into [.foo]
560 my $pathified = VMS::Filespec::pathify($path);
561 $path = $pathified if defined $pathified;
562
563 return VMS::Filespec::rmsexpand($path);
564}
565
566sub _os2_cwd {
567 $ENV{'PWD'} = `cmd /c cd`;
568 chomp $ENV{'PWD'};
569 $ENV{'PWD'} =~ s:\\:/:g ;
570 return $ENV{'PWD'};
571}
572
573sub _win32_cwd_simple {
574 $ENV{'PWD'} = `cd`;
575 chomp $ENV{'PWD'};
576 $ENV{'PWD'} =~ s:\\:/:g ;
577 return $ENV{'PWD'};
578}
579
580sub _win32_cwd {
581 # Need to avoid taking any sort of reference to the typeglob or the code in
582 # the optree, so that this tests the runtime state of things, as the
583 # ExtUtils::MakeMaker tests for "miniperl" need to be able to fake things at
584 # runtime by deleting the subroutine. *foo{THING} syntax on a symbol table
585 # lookup avoids needing a string eval, which has been reported to cause
586 # problems (for reasons that we haven't been able to get to the bottom of -
587 # rt.cpan.org #56225)
588 if (*{$DynaLoader::{boot_DynaLoader}}{CODE}) {
589 $ENV{'PWD'} = Win32::GetCwd();
590 }
591 else { # miniperl
592 chomp($ENV{'PWD'} = `cd`);
593 }
594 $ENV{'PWD'} =~ s:\\:/:g ;
595 return $ENV{'PWD'};
596}
597
5981500ns*_NT_cwd = defined &Win32::GetCwd ? \&_win32_cwd : \&_win32_cwd_simple;
599
600sub _dos_cwd {
601 if (!defined &Dos::GetCwd) {
602 $ENV{'PWD'} = `command /c cd`;
603 chomp $ENV{'PWD'};
604 $ENV{'PWD'} =~ s:\\:/:g ;
605 } else {
606 $ENV{'PWD'} = Dos::GetCwd();
607 }
608 return $ENV{'PWD'};
609}
610
611sub _qnx_cwd {
612 local $ENV{PATH} = '';
613 local $ENV{CDPATH} = '';
614 local $ENV{ENV} = '';
615 $ENV{'PWD'} = `/usr/bin/fullpath -t`;
616 chomp $ENV{'PWD'};
617 return $ENV{'PWD'};
618}
619
620sub _qnx_abs_path {
621 local $ENV{PATH} = '';
622 local $ENV{CDPATH} = '';
623 local $ENV{ENV} = '';
624 my $path = @_ ? shift : '.';
625 local *REALPATH;
626
627 defined( open(REALPATH, '-|') || exec '/usr/bin/fullpath', '-t', $path ) or
628 die "Can't open /usr/bin/fullpath: $!";
629 my $realpath = <REALPATH>;
630 close REALPATH;
631 chomp $realpath;
632 return $realpath;
633}
634
635sub _epoc_cwd {
636 $ENV{'PWD'} = EPOC::getcwd();
637 return $ENV{'PWD'};
638}
639
640# Now that all the base-level functions are set up, alias the
641# user-level functions to the right places
642
64311µsif (exists $METHOD_MAP{$^O}) {
6441400ns my $map = $METHOD_MAP{$^O};
64512µs foreach my $name (keys %$map) {
646 local $^W = 0; # assignments trigger 'subroutine redefined' warning
6472142µs237µs
# spent 24µs (10+14) within Cwd::BEGIN@647 which was called: # once (10µs+14µs) by File::Path::BEGIN@6 at line 647
no strict 'refs';
# spent 24µs making 1 call to Cwd::BEGIN@647 # spent 14µs making 1 call to strict::unimport
648 *{$name} = \&{$map->{$name}};
649 }
650}
651
652# In case the XS version doesn't load.
6531200ns*abs_path = \&_perl_abs_path unless defined &abs_path;
6541100ns*getcwd = \&_perl_getcwd unless defined &getcwd;
655
656# added function alias for those of us more
657# used to the libc function. --tchrist 27-Jan-00
6581500ns*realpath = \&abs_path;
659
660149µs1;
 
# spent 6µs within Cwd::CORE:fteexec which was called: # once (6µs+0s) by File::Path::BEGIN@6 at line 170
sub Cwd::CORE:fteexec; # opcode
# spent 6µs within Cwd::CORE:regcomp which was called: # once (6µs+0s) by File::Path::BEGIN@6 at line 211
sub Cwd::CORE:regcomp; # opcode
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.