← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
  Run on Tue Oct 15 11:58:52 2013
Reported on Tue Oct 15 12:01:04 2013

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