← Index
NYTProf Performance Profile   « block view • line view • sub view »
For C:/lo/libo-master/solenv/bin/make_installer.pl
  Run on Mon Sep 24 00:52:54 2012
Reported on Mon Sep 24 07:34:35 2012

Filename/usr/lib/perl5/5.14/i686-cygwin-threads-64int/Cwd.pm
StatementsExecuted 10071 statements in 116ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1001111760.8ms93.3msCwd::::__ANON__[:406]Cwd::__ANON__[:406]
100111132.5ms32.5msCwd::::cwdCwd::cwd (xsub)
111713µs713µsCwd::::CORE:fteexecCwd::CORE:fteexec (opcode)
111211µs221µsCwd::::BEGIN@170Cwd::BEGIN@170
11137µs102µsCwd::::BEGIN@818Cwd::BEGIN@818
11117µs70µsCwd::::BEGIN@171Cwd::BEGIN@171
11113µs132µsCwd::::BEGIN@172Cwd::BEGIN@172
11110µs10µsCwd::::BEGIN@209Cwd::BEGIN@209
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
3=head1 NAME
4
5Cwd - get pathname of current working directory
6
7=head1 SYNOPSIS
8
9 use Cwd;
10 my $dir = getcwd;
11
12 use Cwd 'abs_path';
13 my $abs_path = abs_path($file);
14
15=head1 DESCRIPTION
16
17This module provides functions for determining the pathname of the
18current working directory. It is recommended that getcwd (or another
19*cwd() function) be used in I<all> code to ensure portability.
20
21By default, it exports the functions cwd(), getcwd(), fastcwd(), and
22fastgetcwd() (and, on Win32, getdcwd()) into the caller's namespace.
23
24
25=head2 getcwd and friends
26
27Each of these functions are called without arguments and return the
28absolute path of the current working directory.
29
30=over 4
31
32=item getcwd
33
34 my $cwd = getcwd();
35
36Returns the current working directory.
37
38Exposes the POSIX function getcwd(3) or re-implements it if it's not
39available.
40
41=item cwd
42
43 my $cwd = cwd();
44
45The cwd() is the most natural form for the current architecture. For
46most systems it is identical to `pwd` (but without the trailing line
47terminator).
48
49=item fastcwd
50
51 my $cwd = fastcwd();
52
53A more dangerous version of getcwd(), but potentially faster.
54
55It might conceivably chdir() you out of a directory that it can't
56chdir() you back into. If fastcwd encounters a problem it will return
57undef but will probably leave you in a different directory. For a
58measure of extra security, if everything appears to have worked, the
59fastcwd() function will check that it leaves you in the same directory
60that it started in. If it has changed it will C<die> with the message
61"Unstable directory path, current directory changed
62unexpectedly". That should never happen.
63
64=item fastgetcwd
65
66 my $cwd = fastgetcwd();
67
68The fastgetcwd() function is provided as a synonym for cwd().
69
70=item getdcwd
71
72 my $cwd = getdcwd();
73 my $cwd = getdcwd('C:');
74
75The getdcwd() function is also provided on Win32 to get the current working
76directory on the specified drive, since Windows maintains a separate current
77working directory for each drive. If no drive is specified then the current
78drive is assumed.
79
80This function simply calls the Microsoft C library _getdcwd() function.
81
82=back
83
84
85=head2 abs_path and friends
86
87These functions are exported only on request. They each take a single
88argument and return the absolute pathname for it. If no argument is
89given they'll use the current working directory.
90
91=over 4
92
93=item abs_path
94
95 my $abs_path = abs_path($file);
96
97Uses the same algorithm as getcwd(). Symbolic links and relative-path
98components ("." and "..") are resolved to return the canonical
99pathname, just like realpath(3).
100
101=item realpath
102
103 my $abs_path = realpath($file);
104
105A synonym for abs_path().
106
107=item fast_abs_path
108
109 my $abs_path = fast_abs_path($file);
110
111A more dangerous, but potentially faster version of abs_path.
112
113=back
114
115=head2 $ENV{PWD}
116
117If you ask to override your chdir() built-in function,
118
119 use Cwd qw(chdir);
120
121then your PWD environment variable will be kept up to date. Note that
122it will only be kept up to date if all packages which use chdir import
123it from Cwd.
124
125
126=head1 NOTES
127
128=over 4
129
130=item *
131
132Since the path separators are different on some operating systems ('/'
133on Unix, ':' on MacPerl, etc...) we recommend you use the File::Spec
134modules wherever portability is a concern.
135
136=item *
137
138Actually, on Mac OS, the C<getcwd()>, C<fastgetcwd()> and C<fastcwd()>
139functions are all aliases for the C<cwd()> function, which, on Mac OS,
140calls `pwd`. Likewise, the C<abs_path()> function is an alias for
141C<fast_abs_path()>.
142
143=back
144
145=head1 AUTHOR
146
147Originally by the perl5-porters.
148
149Maintained by Ken Williams <KWILLIAMS@cpan.org>
150
151=head1 COPYRIGHT
152
153Copyright (c) 2004 by the Perl 5 Porters. All rights reserved.
154
155This program is free software; you can redistribute it and/or modify
156it under the same terms as Perl itself.
157
158Portions of the C code in this library are copyright (c) 1994 by the
159Regents of the University of California. All rights reserved. The
160license on this code is compatible with the licensing of the rest of
161the distribution - please see the source code in F<Cwd.xs> for the
162details.
163
164=head1 SEE ALSO
165
166L<File::chdir>
167
168=cut
169
170259µs2231µs
# spent 221µs (211+10) within Cwd::BEGIN@170 which was called: # once (211µs+10µs) by installer::BEGIN@32 at line 170
use strict;
# spent 221µs making 1 call to Cwd::BEGIN@170 # spent 10µs making 1 call to strict::import
171265µs2124µs
# spent 70µs (17+53) within Cwd::BEGIN@171 which was called: # once (17µs+53µs) by installer::BEGIN@32 at line 171
use Exporter;
# spent 70µs making 1 call to Cwd::BEGIN@171 # spent 53µs making 1 call to Exporter::import
1722429µs2251µs
# spent 132µs (13+119) within Cwd::BEGIN@172 which was called: # once (13µs+119µs) by installer::BEGIN@32 at line 172
use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
# spent 132µs making 1 call to Cwd::BEGIN@172 # spent 119µs making 1 call to vars::import
173
17412µs$VERSION = '3.36';
17512µsmy $xs_version = $VERSION;
176140µs$VERSION = eval $VERSION;
# spent 8µs executing statements in string eval
177
178119µs@ISA = qw/ Exporter /;
17913µs@EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
18013µspush @EXPORT, qw(getdcwd) if $^O eq 'MSWin32';
18113µs@EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
182
183# sys_cwd may keep the builtin command
184
185# All the functionality of this module may provided by builtins,
186# there is no sense to process the rest of the file.
187# The best choice may be to have this in BEGIN, but how to return from BEGIN?
188
1891500nsif ($^O eq 'os2') {
190 local $^W = 0;
191
192 *cwd = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
193 *getcwd = \&cwd;
194 *fastgetcwd = \&cwd;
195 *fastcwd = \&cwd;
196
197 *fast_abs_path = \&sys_abspath if defined &sys_abspath;
198 *abs_path = \&fast_abs_path;
199 *realpath = \&fast_abs_path;
200 *fast_realpath = \&fast_abs_path;
201
202 return 1;
203}
204
205# Need to look up the feature settings on VMS. The preferred way is to use the
206# VMS::Feature module, but that may not be available to dual life modules.
207
2081600nsmy $use_vms_feature;
209
# spent 10µs within Cwd::BEGIN@209 which was called: # once (10µs+0s) by installer::BEGIN@32 at line 215
BEGIN {
210110µs if ($^O eq 'VMS') {
211 if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
212 $use_vms_feature = 1;
213 }
214 }
21517.07ms110µs}
# spent 10µs making 1 call to Cwd::BEGIN@209
216
217# Need to look up the UNIX report mode. This may become a dynamic mode
218# in the future.
219sub _vms_unix_rpt {
220 my $unix_rpt;
221 if ($use_vms_feature) {
222 $unix_rpt = VMS::Feature::current("filename_unix_report");
223 } else {
224 my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
225 $unix_rpt = $env_unix_rpt =~ /^[ET1]/i;
226 }
227 return $unix_rpt;
228}
229
230# Need to look up the EFS character set mode. This may become a dynamic
231# mode in the future.
232sub _vms_efs {
233 my $efs;
234 if ($use_vms_feature) {
235 $efs = VMS::Feature::current("efs_charset");
236 } else {
237 my $env_efs = $ENV{'DECC$EFS_CHARSET'} || '';
238 $efs = $env_efs =~ /^[ET1]/i;
239 }
240 return $efs;
241}
242
243
244# If loading the XS stuff doesn't work, we can fall back to pure perl
24526µseval {
24623.79ms if ( $] >= 5.006 ) {
247 require XSLoader;
2481633µs XSLoader::load( __PACKAGE__, $xs_version);
# spent 633µs making 1 call to XSLoader::load
249 } else {
250 require DynaLoader;
251 push @ISA, 'DynaLoader';
252 __PACKAGE__->bootstrap( $xs_version );
253 }
254};
255
256# Must be after the DynaLoader stuff:
257175µs$VERSION = eval $VERSION;
# spent 6µs executing statements in string eval
258
259# Big nasty table of function aliases
260160µsmy %METHOD_MAP =
261 (
262 VMS =>
263 {
264 cwd => '_vms_cwd',
265 getcwd => '_vms_cwd',
266 fastcwd => '_vms_cwd',
267 fastgetcwd => '_vms_cwd',
268 abs_path => '_vms_abs_path',
269 fast_abs_path => '_vms_abs_path',
270 },
271
272 MSWin32 =>
273 {
274 # We assume that &_NT_cwd is defined as an XSUB or in the core.
275 cwd => '_NT_cwd',
276 getcwd => '_NT_cwd',
277 fastcwd => '_NT_cwd',
278 fastgetcwd => '_NT_cwd',
279 abs_path => 'fast_abs_path',
280 realpath => 'fast_abs_path',
281 },
282
283 dos =>
284 {
285 cwd => '_dos_cwd',
286 getcwd => '_dos_cwd',
287 fastgetcwd => '_dos_cwd',
288 fastcwd => '_dos_cwd',
289 abs_path => 'fast_abs_path',
290 },
291
292 # QNX4. QNX6 has a $os of 'nto'.
293 qnx =>
294 {
295 cwd => '_qnx_cwd',
296 getcwd => '_qnx_cwd',
297 fastgetcwd => '_qnx_cwd',
298 fastcwd => '_qnx_cwd',
299 abs_path => '_qnx_abs_path',
300 fast_abs_path => '_qnx_abs_path',
301 },
302
303 cygwin =>
304 {
305 getcwd => 'cwd',
306 fastgetcwd => 'cwd',
307 fastcwd => 'cwd',
308 abs_path => 'fast_abs_path',
309 realpath => 'fast_abs_path',
310 },
311
312 epoc =>
313 {
314 cwd => '_epoc_cwd',
315 getcwd => '_epoc_cwd',
316 fastgetcwd => '_epoc_cwd',
317 fastcwd => '_epoc_cwd',
318 abs_path => 'fast_abs_path',
319 },
320
321 MacOS =>
322 {
323 getcwd => 'cwd',
324 fastgetcwd => 'cwd',
325 fastcwd => 'cwd',
326 abs_path => 'fast_abs_path',
327 },
328 );
329
33012µs$METHOD_MAP{NT} = $METHOD_MAP{MSWin32};
331
332
333# Find the pwd command in the expected locations. We assume these
334# are safe. This prevents _backtick_pwd() consulting $ENV{PATH}
335# so everything works under taint mode.
3361500nsmy $pwd_cmd;
33712µsforeach my $try ('/bin/pwd',
338 '/usr/bin/pwd',
339 '/QOpenSys/bin/pwd', # OS/400 PASE.
340 ) {
341
3423732µs1713µs if( -x $try ) {
# spent 713µs making 1 call to Cwd::CORE:fteexec
343 $pwd_cmd = $try;
344 last;
345 }
346}
34712µsmy $found_pwd_cmd = defined($pwd_cmd);
34811µsunless ($pwd_cmd) {
349 # Isn't this wrong? _backtick_pwd() will fail if somenone has
350 # pwd in their path but it is not /bin/pwd or /usr/bin/pwd?
351 # See [perl #16774]. --jhi
352 $pwd_cmd = 'pwd';
353}
354
355# Lazy-load Carp
356sub _carp { require Carp; Carp::carp(@_) }
357sub _croak { require Carp; Carp::croak(@_) }
358
359# The 'natural and safe form' for UNIX (pwd may be setuid root)
360sub _backtick_pwd {
361 # Localize %ENV entries in a way that won't create new hash keys
362 my @localize = grep exists $ENV{$_}, qw(PATH IFS CDPATH ENV BASH_ENV);
363 local @ENV{@localize};
364
365 my $cwd = `$pwd_cmd`;
366 # Belt-and-suspenders in case someone said "undef $/".
367 local $/ = "\n";
368 # `pwd` may fail e.g. if the disk is full
369 chomp($cwd) if defined $cwd;
370 $cwd;
371}
372
373# Since some ports may predefine cwd internally (e.g., NT)
374# we take care not to override an existing definition for cwd().
375
37615µsunless ($METHOD_MAP{$^O}{cwd} or defined &cwd) {
377 # The pwd command is not available in some chroot(2)'ed environments
378 my $sep = $Config::Config{path_sep} || ':';
379 my $os = $^O; # Protect $^O from tainting
380
381
382 # Try again to find a pwd, this time searching the whole PATH.
383 if (defined $ENV{PATH} and $os ne 'MSWin32') { # no pwd on Windows
384 my @candidates = split($sep, $ENV{PATH});
385 while (!$found_pwd_cmd and @candidates) {
386 my $candidate = shift @candidates;
387 $found_pwd_cmd = 1 if -x "$candidate/pwd";
388 }
389 }
390
391 # MacOS has some special magic to make `pwd` work.
392 if( $os eq 'MacOS' || $found_pwd_cmd )
393 {
394 *cwd = \&_backtick_pwd;
395 }
396 else {
397 *cwd = \&getcwd;
398 }
399}
400
401421µsif ($^O eq 'cygwin') {
402 # We need to make sure cwd() is called with no args, because it's
403 # got an arg-less prototype and will die if args are present.
404 local $^W = 0;
405 my $orig_cwd = \&cwd;
40610011103ms1001132.5ms
# spent 93.3ms (60.8+32.5) within Cwd::__ANON__[/usr/lib/perl5/5.14/i686-cygwin-threads-64int/Cwd.pm:406] which was called 10011 times, avg 9µs/call: # 9982 times (60.5ms+32.4ms) by Archive::Zip::_asLocalName at line 551 of Archive/Zip.pm, avg 9µs/call # 5 times (62µs+30µs) by installer::windows::mergemodule::merge_mergemodules_into_msi_database at line 105 of /cygdrive/c/lo/libo-master/instsetoo_native/util/C:/lo/libo-master/solenv/bin/modules/installer/windows/mergemodule.pm, avg 18µs/call # 5 times (55µs+28µs) by installer::windows::mergemodule::change_file_table at line 1123 of /cygdrive/c/lo/libo-master/instsetoo_native/util/C:/lo/libo-master/solenv/bin/modules/installer/windows/mergemodule.pm, avg 17µs/call # 5 times (52µs+26µs) by installer::windows::mergemodule::merge_mergemodules_into_msi_database at line 357 of /cygdrive/c/lo/libo-master/instsetoo_native/util/C:/lo/libo-master/solenv/bin/modules/installer/windows/mergemodule.pm, avg 16µs/call # 5 times (32µs+17µs) by File::Spec::Unix::_cwd at line 483 of File/Spec/Unix.pm, avg 10µs/call # 3 times (29µs+17µs) by installer::parameter::make_path_absolute at line 218 of /cygdrive/c/lo/libo-master/instsetoo_native/util/C:/lo/libo-master/solenv/bin/modules/installer/parameter.pm, avg 16µs/call # 2 times (17µs+7µs) by installer::archivefiles::resolving_archive_flag at line 284 of /cygdrive/c/lo/libo-master/instsetoo_native/util/C:/lo/libo-master/solenv/bin/modules/installer/archivefiles.pm, avg 12µs/call # once (14µs+6µs) by installer::windows::msiglobal::include_cabs_into_msi at line 1230 of /cygdrive/c/lo/libo-master/instsetoo_native/util/C:/lo/libo-master/solenv/bin/modules/installer/windows/msiglobal.pm # once (10µs+6µs) by installer::windows::msiglobal::execute_packaging at line 1303 of /cygdrive/c/lo/libo-master/instsetoo_native/util/C:/lo/libo-master/solenv/bin/modules/installer/windows/msiglobal.pm # once (10µs+6µs) by installer::windows::msiglobal::create_transforms at line 778 of /cygdrive/c/lo/libo-master/instsetoo_native/util/C:/lo/libo-master/solenv/bin/modules/installer/windows/msiglobal.pm # once (9µs+5µs) by installer::run at line 138 of /cygdrive/c/lo/libo-master/instsetoo_native/util/C:/lo/libo-master/solenv/bin/modules/installer.pm
*cwd = sub { &$orig_cwd() }
# spent 32.5ms making 10011 calls to Cwd::cwd, avg 3µs/call
407}
408
409
410# set a reasonable (and very safe) default for fastgetcwd, in case it
411# isn't redefined later (20001212 rspier)
41212µs*fastgetcwd = \&cwd;
413
414# A non-XS version of getcwd() - also used to bootstrap the perl build
415# process, when miniperl is running and no XS loading happens.
416sub _perl_getcwd
417{
418 abs_path('.');
419}
420
421# By John Bazik
422#
423# Usage: $cwd = &fastcwd;
424#
425# This is a faster version of getcwd. It's also more dangerous because
426# you might chdir out of a directory that you can't chdir back into.
427
428sub fastcwd_ {
429 my($odev, $oino, $cdev, $cino, $tdev, $tino);
430 my(@path, $path);
431 local(*DIR);
432
433 my($orig_cdev, $orig_cino) = stat('.');
434 ($cdev, $cino) = ($orig_cdev, $orig_cino);
435 for (;;) {
436 my $direntry;
437 ($odev, $oino) = ($cdev, $cino);
438 CORE::chdir('..') || return undef;
439 ($cdev, $cino) = stat('.');
440 last if $odev == $cdev && $oino == $cino;
441 opendir(DIR, '.') || return undef;
442 for (;;) {
443 $direntry = readdir(DIR);
444 last unless defined $direntry;
445 next if $direntry eq '.';
446 next if $direntry eq '..';
447
448 ($tdev, $tino) = lstat($direntry);
449 last unless $tdev != $odev || $tino != $oino;
450 }
451 closedir(DIR);
452 return undef unless defined $direntry; # should never happen
453 unshift(@path, $direntry);
454 }
455 $path = '/' . join('/', @path);
456 if ($^O eq 'apollo') { $path = "/".$path; }
457 # At this point $path may be tainted (if tainting) and chdir would fail.
458 # Untaint it then check that we landed where we started.
459 $path =~ /^(.*)\z/s # untaint
460 && CORE::chdir($1) or return undef;
461 ($cdev, $cino) = stat('.');
462 die "Unstable directory path, current directory changed unexpectedly"
463 if $cdev != $orig_cdev || $cino != $orig_cino;
464 $path;
465}
46613µsif (not defined &fastcwd) { *fastcwd = \&fastcwd_ }
467
468
469# Keeps track of current working directory in PWD environment var
470# Usage:
471# use Cwd 'chdir';
472# chdir $newdir;
473
47411µsmy $chdir_init = 0;
475
476sub chdir_init {
477 if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos' and $^O ne 'MSWin32') {
478 my($dd,$di) = stat('.');
479 my($pd,$pi) = stat($ENV{'PWD'});
480 if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
481 $ENV{'PWD'} = cwd();
482 }
483 }
484 else {
485 my $wd = cwd();
486 $wd = Win32::GetFullPathName($wd) if $^O eq 'MSWin32';
487 $ENV{'PWD'} = $wd;
488 }
489 # Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
490 if ($^O ne 'MSWin32' and $ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|s) {
491 my($pd,$pi) = stat($2);
492 my($dd,$di) = stat($1);
493 if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
494 $ENV{'PWD'}="$2$3";
495 }
496 }
497 $chdir_init = 1;
498}
499
500sub chdir {
501 my $newdir = @_ ? shift : ''; # allow for no arg (chdir to HOME dir)
502 $newdir =~ s|///*|/|g unless $^O eq 'MSWin32';
503 chdir_init() unless $chdir_init;
504 my $newpwd;
505 if ($^O eq 'MSWin32') {
506 # get the full path name *before* the chdir()
507 $newpwd = Win32::GetFullPathName($newdir);
508 }
509
510 return 0 unless CORE::chdir $newdir;
511
512 if ($^O eq 'VMS') {
513 return $ENV{'PWD'} = $ENV{'DEFAULT'}
514 }
515 elsif ($^O eq 'MacOS') {
516 return $ENV{'PWD'} = cwd();
517 }
518 elsif ($^O eq 'MSWin32') {
519 $ENV{'PWD'} = $newpwd;
520 return 1;
521 }
522
523 if (ref $newdir eq 'GLOB') { # in case a file/dir handle is passed in
524 $ENV{'PWD'} = cwd();
525 } elsif ($newdir =~ m#^/#s) {
526 $ENV{'PWD'} = $newdir;
527 } else {
528 my @curdir = split(m#/#,$ENV{'PWD'});
529 @curdir = ('') unless @curdir;
530 my $component;
531 foreach $component (split(m#/#, $newdir)) {
532 next if $component eq '.';
533 pop(@curdir),next if $component eq '..';
534 push(@curdir,$component);
535 }
536 $ENV{'PWD'} = join('/',@curdir) || '/';
537 }
538 1;
539}
540
541
542sub _perl_abs_path
543{
544 my $start = @_ ? shift : '.';
545 my($dotdots, $cwd, @pst, @cst, $dir, @tst);
546
547 unless (@cst = stat( $start ))
548 {
549 _carp("stat($start): $!");
550 return '';
551 }
552
553 unless (-d _) {
554 # Make sure we can be invoked on plain files, not just directories.
555 # NOTE that this routine assumes that '/' is the only directory separator.
556
557 my ($dir, $file) = $start =~ m{^(.*)/(.+)$}
558 or return cwd() . '/' . $start;
559
560 # Can't use "-l _" here, because the previous stat was a stat(), not an lstat().
561 if (-l $start) {
562 my $link_target = readlink($start);
563 die "Can't resolve link $start: $!" unless defined $link_target;
564
565 require File::Spec;
566 $link_target = $dir . '/' . $link_target
567 unless File::Spec->file_name_is_absolute($link_target);
568
569 return abs_path($link_target);
570 }
571
572 return $dir ? abs_path($dir) . "/$file" : "/$file";
573 }
574
575 $cwd = '';
576 $dotdots = $start;
577 do
578 {
579 $dotdots .= '/..';
580 @pst = @cst;
581 local *PARENT;
582 unless (opendir(PARENT, $dotdots))
583 {
584 # probably a permissions issue. Try the native command.
585 return File::Spec->rel2abs( $start, _backtick_pwd() );
586 }
587 unless (@cst = stat($dotdots))
588 {
589 _carp("stat($dotdots): $!");
590 closedir(PARENT);
591 return '';
592 }
593 if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
594 {
595 $dir = undef;
596 }
597 else
598 {
599 do
600 {
601 unless (defined ($dir = readdir(PARENT)))
602 {
603 _carp("readdir($dotdots): $!");
604 closedir(PARENT);
605 return '';
606 }
607 $tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir"))
608 }
609 while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
610 $tst[1] != $pst[1]);
611 }
612 $cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ;
613 closedir(PARENT);
614 } while (defined $dir);
615 chop($cwd) unless $cwd eq '/'; # drop the trailing /
616 $cwd;
617}
618
619
62011µsmy $Curdir;
621sub fast_abs_path {
622 local $ENV{PWD} = $ENV{PWD} || ''; # Guard against clobberage
623 my $cwd = getcwd();
624 require File::Spec;
625 my $path = @_ ? shift : ($Curdir ||= File::Spec->curdir);
626
627 # Detaint else we'll explode in taint mode. This is safe because
628 # we're not doing anything dangerous with it.
629 ($path) = $path =~ /(.*)/;
630 ($cwd) = $cwd =~ /(.*)/;
631
632 unless (-e $path) {
633 _croak("$path: No such file or directory");
634 }
635
636 unless (-d _) {
637 # Make sure we can be invoked on plain files, not just directories.
638
639 my ($vol, $dir, $file) = File::Spec->splitpath($path);
640 return File::Spec->catfile($cwd, $path) unless length $dir;
641
642 if (-l $path) {
643 my $link_target = readlink($path);
644 die "Can't resolve link $path: $!" unless defined $link_target;
645
646 $link_target = File::Spec->catpath($vol, $dir, $link_target)
647 unless File::Spec->file_name_is_absolute($link_target);
648
649 return fast_abs_path($link_target);
650 }
651
652 return $dir eq File::Spec->rootdir
653 ? File::Spec->catpath($vol, $dir, $file)
654 : fast_abs_path(File::Spec->catpath($vol, $dir, '')) . '/' . $file;
655 }
656
657 if (!CORE::chdir($path)) {
658 _croak("Cannot chdir to $path: $!");
659 }
660 my $realpath = getcwd();
661 if (! ((-d $cwd) && (CORE::chdir($cwd)))) {
662 _croak("Cannot chdir back to $cwd: $!");
663 }
664 $realpath;
665}
666
667# added function alias to follow principle of least surprise
668# based on previous aliasing. --tchrist 27-Jan-00
66912µs*fast_realpath = \&fast_abs_path;
670
671
672# --- PORTING SECTION ---
673
674# VMS: $ENV{'DEFAULT'} points to default directory at all times
675# 06-Mar-1996 Charles Bailey bailey@newman.upenn.edu
676# Note: Use of Cwd::chdir() causes the logical name PWD to be defined
677# in the process logical name table as the default device and directory
678# seen by Perl. This may not be the same as the default device
679# and directory seen by DCL after Perl exits, since the effects
680# the CRTL chdir() function persist only until Perl exits.
681
682sub _vms_cwd {
683 return $ENV{'DEFAULT'};
684}
685
686sub _vms_abs_path {
687 return $ENV{'DEFAULT'} unless @_;
688 my $path = shift;
689
690 my $efs = _vms_efs;
691 my $unix_rpt = _vms_unix_rpt;
692
693 if (defined &VMS::Filespec::vmsrealpath) {
694 my $path_unix = 0;
695 my $path_vms = 0;
696
697 $path_unix = 1 if ($path =~ m#(?<=\^)/#);
698 $path_unix = 1 if ($path =~ /^\.\.?$/);
699 $path_vms = 1 if ($path =~ m#[\[<\]]#);
700 $path_vms = 1 if ($path =~ /^--?$/);
701
702 my $unix_mode = $path_unix;
703 if ($efs) {
704 # In case of a tie, the Unix report mode decides.
705 if ($path_vms == $path_unix) {
706 $unix_mode = $unix_rpt;
707 } else {
708 $unix_mode = 0 if $path_vms;
709 }
710 }
711
712 if ($unix_mode) {
713 # Unix format
714 return VMS::Filespec::unixrealpath($path);
715 }
716
717 # VMS format
718
719 my $new_path = VMS::Filespec::vmsrealpath($path);
720
721 # Perl expects directories to be in directory format
722 $new_path = VMS::Filespec::pathify($new_path) if -d $path;
723 return $new_path;
724 }
725
726 # Fallback to older algorithm if correct ones are not
727 # available.
728
729 if (-l $path) {
730 my $link_target = readlink($path);
731 die "Can't resolve link $path: $!" unless defined $link_target;
732
733 return _vms_abs_path($link_target);
734 }
735
736 # may need to turn foo.dir into [.foo]
737 my $pathified = VMS::Filespec::pathify($path);
738 $path = $pathified if defined $pathified;
739
740 return VMS::Filespec::rmsexpand($path);
741}
742
743sub _os2_cwd {
744 $ENV{'PWD'} = `cmd /c cd`;
745 chomp $ENV{'PWD'};
746 $ENV{'PWD'} =~ s:\\:/:g ;
747 return $ENV{'PWD'};
748}
749
750sub _win32_cwd_simple {
751 $ENV{'PWD'} = `cd`;
752 chomp $ENV{'PWD'};
753 $ENV{'PWD'} =~ s:\\:/:g ;
754 return $ENV{'PWD'};
755}
756
757sub _win32_cwd {
758 if (eval 'defined &DynaLoader::boot_DynaLoader') {
759 $ENV{'PWD'} = Win32::GetCwd();
760 }
761 else { # miniperl
762 chomp($ENV{'PWD'} = `cd`);
763 }
764 $ENV{'PWD'} =~ s:\\:/:g ;
765 return $ENV{'PWD'};
766}
767
76813µs*_NT_cwd = defined &Win32::GetCwd ? \&_win32_cwd : \&_win32_cwd_simple;
769
770sub _dos_cwd {
771 if (!defined &Dos::GetCwd) {
772 $ENV{'PWD'} = `command /c cd`;
773 chomp $ENV{'PWD'};
774 $ENV{'PWD'} =~ s:\\:/:g ;
775 } else {
776 $ENV{'PWD'} = Dos::GetCwd();
777 }
778 return $ENV{'PWD'};
779}
780
781sub _qnx_cwd {
782 local $ENV{PATH} = '';
783 local $ENV{CDPATH} = '';
784 local $ENV{ENV} = '';
785 $ENV{'PWD'} = `/usr/bin/fullpath -t`;
786 chomp $ENV{'PWD'};
787 return $ENV{'PWD'};
788}
789
790sub _qnx_abs_path {
791 local $ENV{PATH} = '';
792 local $ENV{CDPATH} = '';
793 local $ENV{ENV} = '';
794 my $path = @_ ? shift : '.';
795 local *REALPATH;
796
797 defined( open(REALPATH, '-|') || exec '/usr/bin/fullpath', '-t', $path ) or
798 die "Can't open /usr/bin/fullpath: $!";
799 my $realpath = <REALPATH>;
800 close REALPATH;
801 chomp $realpath;
802 return $realpath;
803}
804
805sub _epoc_cwd {
806 $ENV{'PWD'} = EPOC::getcwd();
807 return $ENV{'PWD'};
808}
809
810
811# Now that all the base-level functions are set up, alias the
812# user-level functions to the right places
813
814310µsif (exists $METHOD_MAP{$^O}) {
815 my $map = $METHOD_MAP{$^O};
816 foreach my $name (keys %$map) {
8171028µs local $^W = 0; # assignments trigger 'subroutine redefined' warning
8182454µs2168µs
# spent 102µs (37+65) within Cwd::BEGIN@818 which was called: # once (37µs+65µs) by installer::BEGIN@32 at line 818
no strict 'refs';
# spent 102µs making 1 call to Cwd::BEGIN@818 # spent 65µs making 1 call to strict::unimport
819 *{$name} = \&{$map->{$name}};
820 }
821}
822
823# In case the XS version doesn't load.
82411µs*abs_path = \&_perl_abs_path unless defined &abs_path;
82511µs*getcwd = \&_perl_getcwd unless defined &getcwd;
826
827# added function alias for those of us more
828# used to the libc function. --tchrist 27-Jan-00
82911µs*realpath = \&abs_path;
830
8311337µs1;
 
# spent 713µs within Cwd::CORE:fteexec which was called: # once (713µs+0s) by installer::BEGIN@32 at line 342
sub Cwd::CORE:fteexec; # opcode
# spent 32.5ms within Cwd::cwd which was called 10011 times, avg 3µs/call: # 10011 times (32.5ms+0s) by Cwd::__ANON__[/usr/lib/perl5/5.14/i686-cygwin-threads-64int/Cwd.pm:406] at line 406, avg 3µs/call
sub Cwd::cwd; # xsub
Report produced by the NYTProf 4.09 Perl profiler, developed by Tim Bunce and Adam Kaplan.