[ Index ]

PHP Cross Reference of Unnamed Project

title

Body

[close]

/se3-unattended/var/se3/unattended/install/linuxaux/opt/perl/lib/5.10.0/i586-linux-thread-multi/ -> Cwd.pm (source)

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


Generated: Tue Mar 17 22:47:18 2015 Cross-referenced by PHPXref 0.7.1