Assimilate Cwd 2.12 from CPAN. Cwd wasn't in Maintainers, so change
Nicholas Clark [Sat, 27 Dec 2003 17:20:23 +0000 (17:20 +0000)]
21646 was only applied to core (must punt this back and thereby unfork)
Need to fix test boilerplate properly for PERL_CORE

p4raw-id: //depot/perl@21972

MANIFEST
Porting/Maintainers.pl
ext/Cwd/Cwd.xs
ext/Cwd/t/cwd.t
ext/Cwd/t/taint.t
lib/Cwd.pm

index e851d1d..a0e533d 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -130,6 +130,7 @@ ext/ByteLoader/byterun.c    Runtime support for bytecode loader
 ext/ByteLoader/byterun.h       Header for byterun.c
 ext/ByteLoader/hints/sunos.pl  Hints for named architecture
 ext/ByteLoader/Makefile.PL     Bytecode loader makefile writer
+ext/Cwd/Changes                        Cwd extension Changelog
 ext/Cwd/Cwd.xs                 Cwd extension external subroutines
 ext/Cwd/Makefile.PL            Cwd extension makefile maker
 ext/Cwd/t/cwd.t                        See if Cwd works
index bcdb25a..7f90a78 100644 (file)
@@ -108,6 +108,13 @@ package Maintainers;
                'CPAN'          => 1,
                },
 
+       'Cwd' =>
+               {
+               'MAINTAINER'    => 'kwilliams',
+               'FILES'         => q[ext/Cwd lib/Cwd.pm],
+               'CPAN'          => 1,
+               },
+
        'Data::Dumper' =>
                {
                'MAINTAINER'    => 'ilyam', # Not gsar.
index 4600fef..6f8dc96 100644 (file)
@@ -210,6 +210,157 @@ err2:
 #endif
 }
 
+#ifndef getcwd_sv
+// Taken from perl 5.8's util.c
+int getcwd_sv(pTHX_ register SV *sv)
+{
+#ifndef PERL_MICRO
+
+#ifndef INCOMPLETE_TAINTS
+    SvTAINTED_on(sv);
+#endif
+
+#ifdef HAS_GETCWD
+    {
+       char buf[MAXPATHLEN];
+
+       /* Some getcwd()s automatically allocate a buffer of the given
+        * size from the heap if they are given a NULL buffer pointer.
+        * The problem is that this behaviour is not portable. */
+       if (getcwd(buf, sizeof(buf) - 1)) {
+           STRLEN len = strlen(buf);
+           sv_setpvn(sv, buf, len);
+           return TRUE;
+       }
+       else {
+           sv_setsv(sv, &PL_sv_undef);
+           return FALSE;
+       }
+    }
+
+#else
+
+    Stat_t statbuf;
+    int orig_cdev, orig_cino, cdev, cino, odev, oino, tdev, tino;
+    int namelen, pathlen=0;
+    DIR *dir;
+    Direntry_t *dp;
+
+    (void)SvUPGRADE(sv, SVt_PV);
+
+    if (PerlLIO_lstat(".", &statbuf) < 0) {
+       SV_CWD_RETURN_UNDEF;
+    }
+
+    orig_cdev = statbuf.st_dev;
+    orig_cino = statbuf.st_ino;
+    cdev = orig_cdev;
+    cino = orig_cino;
+
+    for (;;) {
+       odev = cdev;
+       oino = cino;
+
+       if (PerlDir_chdir("..") < 0) {
+           SV_CWD_RETURN_UNDEF;
+       }
+       if (PerlLIO_stat(".", &statbuf) < 0) {
+           SV_CWD_RETURN_UNDEF;
+       }
+
+       cdev = statbuf.st_dev;
+       cino = statbuf.st_ino;
+
+       if (odev == cdev && oino == cino) {
+           break;
+       }
+       if (!(dir = PerlDir_open("."))) {
+           SV_CWD_RETURN_UNDEF;
+       }
+
+       while ((dp = PerlDir_read(dir)) != NULL) {
+#ifdef DIRNAMLEN
+           namelen = dp->d_namlen;
+#else
+           namelen = strlen(dp->d_name);
+#endif
+           /* skip . and .. */
+           if (SV_CWD_ISDOT(dp)) {
+               continue;
+           }
+
+           if (PerlLIO_lstat(dp->d_name, &statbuf) < 0) {
+               SV_CWD_RETURN_UNDEF;
+           }
+
+           tdev = statbuf.st_dev;
+           tino = statbuf.st_ino;
+           if (tino == oino && tdev == odev) {
+               break;
+           }
+       }
+
+       if (!dp) {
+           SV_CWD_RETURN_UNDEF;
+       }
+
+       if (pathlen + namelen + 1 >= MAXPATHLEN) {
+           SV_CWD_RETURN_UNDEF;
+       }
+
+       SvGROW(sv, pathlen + namelen + 1);
+
+       if (pathlen) {
+           /* shift down */
+           Move(SvPVX(sv), SvPVX(sv) + namelen + 1, pathlen, char);
+       }
+
+       /* prepend current directory to the front */
+       *SvPVX(sv) = '/';
+       Move(dp->d_name, SvPVX(sv)+1, namelen, char);
+       pathlen += (namelen + 1);
+
+#ifdef VOID_CLOSEDIR
+       PerlDir_close(dir);
+#else
+       if (PerlDir_close(dir) < 0) {
+           SV_CWD_RETURN_UNDEF;
+       }
+#endif
+    }
+
+    if (pathlen) {
+       SvCUR_set(sv, pathlen);
+       *SvEND(sv) = '\0';
+       SvPOK_only(sv);
+
+       if (PerlDir_chdir(SvPVX(sv)) < 0) {
+           SV_CWD_RETURN_UNDEF;
+       }
+    }
+    if (PerlLIO_stat(".", &statbuf) < 0) {
+       SV_CWD_RETURN_UNDEF;
+    }
+
+    cdev = statbuf.st_dev;
+    cino = statbuf.st_ino;
+
+    if (cdev != orig_cdev || cino != orig_cino) {
+       Perl_croak(aTHX_ "Unstable directory path, "
+                  "current directory changed unexpectedly");
+    }
+
+    return TRUE;
+#endif
+
+#else
+    return FALSE;
+#endif
+}
+
+#endif
+
+
 MODULE = Cwd           PACKAGE = Cwd
 
 PROTOTYPES: ENABLE
index 514f2b1..92ec184 100644 (file)
@@ -1,12 +1,11 @@
 #!./perl
 
+use Cwd;
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
 }
 
 use Config;
-use Cwd;
 use strict;
 use warnings;
 use File::Spec;
index 2cd7d19..9c6748e 100644 (file)
@@ -1,13 +1,12 @@
 #!./perl -Tw
 # Testing Cwd under taint mode.
 
+use Cwd;
 BEGIN {
     chdir 't' if -d 't';
-    unshift @INC, '../lib';
 }
 
 use strict;
-use Cwd;
 use Test::More tests => 16;
 use Scalar::Util qw/tainted/;
 
@@ -20,6 +19,6 @@ foreach my $func (@Functions) {
     no strict 'refs';
     my $cwd;
     eval { $cwd = &{'Cwd::'.$func} };
-    is( $@, '',                "$func() does not explode under taint mode" );
-    ok( tainted($cwd), "its return value is tainted" );
+    is( $@, '',                "$func() should not explode under taint mode" );
+    ok( tainted($cwd), "its return value should be tainted" );
 }
index 984375f..51ca5b6 100644 (file)
@@ -1,5 +1,4 @@
 package Cwd;
-use 5.006;
 
 =head1 NAME
 
@@ -137,12 +136,14 @@ L<File::chdir>
 =cut
 
 use strict;
+use Exporter;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
 
-our $VERSION = '2.08';
+$VERSION = '2.12';
 
-use base qw/ Exporter /;
-our @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
-our @EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
+@ISA = qw/ Exporter /;
+@EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
+@EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
 
 # sys_cwd may keep the builtin command
 
@@ -150,16 +151,19 @@ our @EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
 # there is no sense to process the rest of the file.
 # The best choice may be to have this in BEGIN, but how to return from BEGIN?
 
-if ($^O eq 'os2' && defined &sys_cwd && defined &sys_abspath) {
+if ($^O eq 'os2') {
     local $^W = 0;
-    *cwd               = \&sys_cwd;
-    *getcwd            = \&cwd;
-    *fastgetcwd                = \&cwd;
-    *fastcwd           = \&cwd;
-    *abs_path          = \&sys_abspath;
-    *fast_abs_path     = \&abs_path;
-    *realpath          = \&abs_path;
-    *fast_realpath     = \&abs_path;
+
+    *cwd                = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
+    *getcwd             = \&cwd;
+    *fastgetcwd         = \&cwd;
+    *fastcwd            = \&cwd;
+
+    *fast_abs_path      = \&sys_abspath if defined &sys_abspath;
+    *abs_path           = \&fast_abs_path;
+    *realpath           = \&fast_abs_path;
+    *fast_realpath      = \&fast_abs_path;
+
     return 1;
 }
 
@@ -191,6 +195,10 @@ unless ($pwd_cmd) {
     }
 }
 
+# Lazy-load Carp
+sub _carp  { require Carp; Carp::carp(@_)  }
+sub _croak { require Carp; Carp::croak(@_) }
+
 # The 'natural and safe form' for UNIX (pwd may be setuid root)
 sub _backtick_pwd {
     local @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)};
@@ -358,8 +366,7 @@ sub _perl_abs_path
 
     unless (@cst = stat( $start ))
     {
-       require Carp;
-       Carp::carp ("stat($start): $!");
+       _carp("stat($start): $!");
        return '';
     }
     $cwd = '';
@@ -371,14 +378,12 @@ sub _perl_abs_path
        local *PARENT;
        unless (opendir(PARENT, $dotdots))
        {
-           require Carp;
-           Carp::carp ("opendir($dotdots): $!");
+           _carp("opendir($dotdots): $!");
            return '';
        }
        unless (@cst = stat($dotdots))
        {
-           require Carp;
-           Carp::carp ("stat($dotdots): $!");
+           _carp("stat($dotdots): $!");
            closedir(PARENT);
            return '';
        }
@@ -392,8 +397,7 @@ sub _perl_abs_path
            {
                unless (defined ($dir = readdir(PARENT)))
                {
-                   require Carp;
-                   Carp::carp ("readdir($dotdots): $!");
+                   _carp("readdir($dotdots): $!");
                    closedir(PARENT);
                    return '';
                }
@@ -426,13 +430,11 @@ sub fast_abs_path {
     ($cwd)  = $cwd  =~ /(.*)/;
 
     if (!CORE::chdir($path)) {
-       require Carp;
-       Carp::croak ("Cannot chdir to $path: $!");
+       _croak("Cannot chdir to $path: $!");
     }
     my $realpath = getcwd();
     if (! ((-d $cwd) && (CORE::chdir($cwd)))) {
-       require Carp;
-       Carp::croak ("Cannot chdir back to $cwd: $!");
+       _croak("Cannot chdir back to $cwd: $!");
     }
     $realpath;
 }
@@ -461,8 +463,7 @@ sub _vms_abs_path {
     my $path = VMS::Filespec::pathify($_[0]);
     if (! defined $path)
        {
-       require Carp;
-       Carp::croak("Invalid path name $_[0]")
+       _croak("Invalid path name $_[0]")
        }
     return VMS::Filespec::rmsexpand($path);
 }
@@ -545,14 +546,6 @@ sub _epoc_cwd {
         *abs_path      = \&fast_abs_path;
         *realpath   = \&fast_abs_path;
     }
-    elsif ($^O eq 'os2') {
-        # sys_cwd may keep the builtin command
-        *cwd           = defined &sys_cwd ? \&sys_cwd : \&_os2_cwd;
-        *getcwd                = \&cwd;
-        *fastgetcwd    = \&cwd;
-        *fastcwd       = \&cwd;
-        *abs_path      = \&fast_abs_path;
-    }
     elsif ($^O eq 'dos') {
         *cwd           = \&_dos_cwd;
         *getcwd                = \&_dos_cwd;
@@ -573,6 +566,7 @@ sub _epoc_cwd {
         *fastgetcwd    = \&cwd;
         *fastcwd       = \&cwd;
         *abs_path      = \&fast_abs_path;
+        *realpath      = \&abs_path;
     }
     elsif ($^O eq 'epoc') {
         *cwd            = \&_epoc_cwd;