From: Benjamin Sugars Date: Fri, 30 Mar 2001 14:08:51 +0000 (-0500) Subject: Re: [PATCH] CwdXS, Take 2 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0d2079faa739aaa999ddace336394cba070395f2;p=p5sagit%2Fp5-mst-13.2.git Re: [PATCH] CwdXS, Take 2 Message-ID: p4raw-id: //depot/perl@9481 --- diff --git a/MANIFEST b/MANIFEST index 061f75f..0a3db84 100644 --- a/MANIFEST +++ b/MANIFEST @@ -145,6 +145,8 @@ ext/ByteLoader/bytecode.h Bytecode header for bytecode loader 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/Cwd/Cwd.xs Cwd extension external subroutines +ext/Cwd/Makefile.PL Cwd extension makefile maker ext/DB_File/Changes Berkeley DB extension change log ext/DB_File/DB_File.pm Berkeley DB extension Perl module ext/DB_File/DB_File.xs Berkeley DB extension external subroutines diff --git a/ext/Cwd/Cwd.xs b/ext/Cwd/Cwd.xs new file mode 100644 index 0000000..d53f05f --- /dev/null +++ b/ext/Cwd/Cwd.xs @@ -0,0 +1,134 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +/* Originally written in Perl by John Bazik; rewritten in C by Ben Sugars. + * Comments from the orignal: + * This is a faster version of getcwd. It's also more dangerous + * because you might chdir out of a directory that you can't chdir + * back into. */ +char * +_cwdxs_fastcwd(void) +{ +/* XXX Should we just use getcwd(3) if available? */ + struct stat statbuf; + int orig_cdev, orig_cino, cdev, cino, odev, oino, tdev, tino; + int i = 0, j = 0, k = 0, ndirs = 16, pathlen = 0, namelen; + DIR *dir; + Direntry_t *dp; + char **names, *path; + + Newz(0, names, ndirs, char*); + + if (PerlLIO_lstat(".", &statbuf) < 0) { + Safefree(names); + return FALSE; + } + 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) { + Safefree(names); + return FALSE; + } + if (PerlLIO_stat(".", &statbuf) < 0) { + Safefree(names); + return FALSE; + } + cdev = statbuf.st_dev; + cino = statbuf.st_ino; + if (odev == cdev && oino == cino) + break; + + if (!(dir = PerlDir_open("."))) { + Safefree(names); + return FALSE; + } + + while ((dp = PerlDir_read(dir)) != NULL) { + if (PerlLIO_lstat(dp->d_name, &statbuf) < 0) { + Safefree(names); + return FALSE; + } + if (strEQ(dp->d_name, ".")) + continue; + if (strEQ(dp->d_name, "..")) + continue; + tdev = statbuf.st_dev; + tino = statbuf.st_ino; + if (tino == oino && tdev == odev) + break; + } + + if (!dp) { + Safefree(names); + return FALSE; + } + + if (i >= ndirs) { + ndirs += 16; + Renew(names, ndirs, char*); + } +#ifdef DIRNAMLEN + namelen = dp->d_namlen; +#else + namelen = strlen(dp->d_name); +#endif + Newz(0, *(names + i), namelen + 1, char); + Copy(dp->d_name, *(names + i), namelen, char); + *(names[i] + namelen) = '\0'; + pathlen += (namelen + 1); + ++i; + + if (PerlDir_close(dir) < 0) { + Safefree(names); + return FALSE; + } + } + + Newz(0, path, pathlen + 1, char); + for (j = i - 1; j >= 0; j--) { + *(path + k) = '/'; + Copy(names[j], path + k + 1, strlen(names[j]) + 1, char); + k = k + strlen(names[j]) + 1; + Safefree(names[j]); + } + + if (PerlDir_chdir(path) < 0) { + Safefree(names); + Safefree(path); + return FALSE; + } + if (PerlLIO_stat(".", &statbuf) < 0) { + Safefree(names); + Safefree(path); + return FALSE; + } + 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"); + + Safefree(names); + return(path); +} + + +MODULE = Cwd PACKAGE = Cwd + +char * +_fastcwd() +PPCODE: + char * buf; + buf = _cwdxs_fastcwd(); + if (buf) { + PUSHs(sv_2mortal(newSVpv(buf, 0))); + Safefree(buf); + } + else + XSRETURN_UNDEF; diff --git a/ext/Cwd/Makefile.PL b/ext/Cwd/Makefile.PL new file mode 100644 index 0000000..ed048a3 --- /dev/null +++ b/ext/Cwd/Makefile.PL @@ -0,0 +1,5 @@ +use ExtUtils::MakeMaker; +WriteMakefile( + NAME => 'Cwd', + VERSION => '2.04', +); diff --git a/lib/Cwd.pm b/lib/Cwd.pm index 6f28088..385f972 100644 --- a/lib/Cwd.pm +++ b/lib/Cwd.pm @@ -121,50 +121,17 @@ sub getcwd abs_path('.'); } -# By John Bazik -# -# Usage: $cwd = &fastcwd; -# -# This is a faster version of getcwd. It's also more dangerous because -# you might chdir out of a directory that you can't chdir back into. - +# Now a callout to an XSUB. We have to delay booting of the XSUB +# until the first time fastcwd is called since Cwd::cwd is needed in the +# building of perl when dynamic loading may be unavailable +my $booted = 0; sub fastcwd { - my($odev, $oino, $cdev, $cino, $tdev, $tino); - my(@path, $path); - local(*DIR); - - my($orig_cdev, $orig_cino) = stat('.'); - ($cdev, $cino) = ($orig_cdev, $orig_cino); - for (;;) { - my $direntry; - ($odev, $oino) = ($cdev, $cino); - CORE::chdir('..') || return undef; - ($cdev, $cino) = stat('.'); - last if $odev == $cdev && $oino == $cino; - opendir(DIR, '.') || return undef; - for (;;) { - $direntry = readdir(DIR); - last unless defined $direntry; - next if $direntry eq '.'; - next if $direntry eq '..'; - - ($tdev, $tino) = lstat($direntry); - last unless $tdev != $odev || $tino != $oino; - } - closedir(DIR); - return undef unless defined $direntry; # should never happen - unshift(@path, $direntry); + unless ($booted) { + require XSLoader; + XSLoader::load("Cwd"); + ++$booted; } - $path = '/' . join('/', @path); - if ($^O eq 'apollo') { $path = "/".$path; } - # At this point $path may be tainted (if tainting) and chdir would fail. - # To be more useful we untaint it then check that we landed where we started. - $path = $1 if $path =~ /^(.*)\z/s; # untaint - CORE::chdir($path) || return undef; - ($cdev, $cino) = stat('.'); - die "Unstable directory path, current directory changed unexpectedly" - if $cdev != $orig_cdev || $cino != $orig_cino; - $path; + return &Cwd::_fastcwd; } diff --git a/t/lib/cwd.t b/t/lib/cwd.t index fa4750e..f852a27 100644 --- a/t/lib/cwd.t +++ b/t/lib/cwd.t @@ -23,6 +23,10 @@ print +(!defined(&chdir) && !defined(&fast_abs_path) ? "" : "not "), "ok 2\n"; +# XXX force Cwd to bootsrap its XSUBs since we have set @INC = "../lib" +# XXX and subsequent chdir()s can make them impossible to find +eval { fastcwd }; + # Must find an external pwd (or equivalent) command. my $pwd_cmd =