X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCwd.pm;h=bee2e179aef6273680f1c5b3414fd67fa3c3d807;hb=79dd614e1e8c3b0e4ed35016e6971240b606da64;hp=2636fd2e4fb3302a353894b39e36f592022380c9;hpb=3712091946b37b5feabcc1f630b32639406ad717;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/Cwd.pm b/lib/Cwd.pm index 2636fd2..bee2e17 100644 --- a/lib/Cwd.pm +++ b/lib/Cwd.pm @@ -1,11 +1,6 @@ package Cwd; require 5.000; require Exporter; -require Config; - -# Use osname for portability switches (doubled to cheaply avoid -w warning) -my $osname = $Config::Config{'osname'} || $Config::Config{'osname'}; - =head1 NAME @@ -31,7 +26,7 @@ getcwd - get pathname of current working directory The getcwd() function re-implements the getcwd(3) (or getwd(3)) functions in Perl. -The fastgetcwd() function looks the same as getcwd(), but runs faster. +The fastcwd() function looks the same as getcwd(), but runs faster. It's also more dangerous because you might conceivably chdir() out of a directory that you can't chdir() back into. @@ -49,7 +44,7 @@ kept up to date it all packages which use chdir import it from Cwd. =cut @ISA = qw(Exporter); -@EXPORT = qw(cwd getcwd fastcwd); +@EXPORT = qw(cwd getcwd fastcwd fastgetcwd); @EXPORT_OK = qw(chdir); # use strict; @@ -177,7 +172,7 @@ sub fastcwd { my $chdir_init = 0; sub chdir_init { - if ($ENV{'PWD'} and $osname ne 'os2') { + if ($ENV{'PWD'} and $^O ne 'os2') { my($dd,$di) = stat('.'); my($pd,$pi) = stat($ENV{'PWD'}); if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) { @@ -203,7 +198,7 @@ sub chdir { $newdir =~ s|///*|/|g; chdir_init() unless $chdir_init; return 0 unless CORE::chdir $newdir; - if ($osname eq 'VMS') { return $ENV{'PWD'} = $ENV{'DEFAULT'} } + if ($^O eq 'VMS') { return $ENV{'PWD'} = $ENV{'DEFAULT'} } if ($newdir =~ m#^/#) { $ENV{'PWD'} = $newdir; @@ -225,21 +220,16 @@ sub chdir { # --- PORTING SECTION --- # VMS: $ENV{'DEFAULT'} points to default directory at all times -# 08-Dec-1994 Charles Bailey bailey@genetics.upenn.edu -# Note: Use of Cwd::getcwd() or Cwd::chdir() (but not Cwd::fastcwd()) -# causes the logical name PWD to be defined in the process -# logical name table as the default device and directory +# 06-Mar-1996 Charles Bailey bailey@genetics.upenn.edu +# Note: Use of Cwd::chdir() causes the logical name PWD to be defined +# in the process logical name table as the default device and directory # seen by Perl. This may not be the same as the default device # and directory seen by DCL after Perl exits, since the effects # the CRTL chdir() function persist only until Perl exits. -# This does not apply to other systems (where only chdir() sets PWD). sub _vms_cwd { return $ENV{'DEFAULT'} } -sub _vms_pwd { - return $ENV{'PWD'} = $ENV{'DEFAULT'} -} sub _os2_cwd { $ENV{'PWD'} = `cmd /c cd`; chop $ENV{'PWD'}; @@ -247,23 +237,27 @@ sub _os2_cwd { return $ENV{'PWD'}; } -if ($osname eq 'VMS') { +my($oldw) = $^W; +$^W = 0; # assignments trigger 'subroutine redefined' warning +if ($^O eq 'VMS') { - *cwd = \&_vms_pwd; - *getcwd = \&_vms_pwd; + *cwd = \&_vms_cwd; + *getcwd = \&_vms_cwd; + *fastcwd = \&_vms_cwd; *fastgetcwd = \&_vms_cwd; } -elsif ($osname eq 'NT') { +elsif ($^O eq 'NT') { *getcwd = \&cwd; *fastgetcwd = \&cwd; } -elsif ($osname eq 'os2') { +elsif ($^O eq 'os2') { *cwd = \&_os2_cwd; *getcwd = \&_os2_cwd; *fastgetcwd = \&_os2_cwd; *fastcwd = \&_os2_cwd; } +$^W = $oldw; # package main; eval join('',) || die $@; # quick test