develooper Front page | perl.perl5.porters | Postings from March 2001

Re: [PATCH] CwdXS, Take 2

Thread Previous | Thread Next
From:
Benjamin Sugars
Date:
March 30, 2001 11:09
Subject:
Re: [PATCH] CwdXS, Take 2
Message ID:
Pine.LNX.4.21.0103301357490.1927-100000@marmot.rim.canoe.ca
On Fri, 30 Mar 2001, Jarkko Hietaniemi wrote:

> On Thu, Mar 29, 2001 at 10:41:25PM -0800, Gurusamy Sarathy wrote:
> > 
> > Given the importance of cwd() for the build process, xsutils.c is probably
> > not a bad place for it.
> 
> Or util.c.

Wherever the C code goes, we still need some XS to allow Perl code to see
it (unless we make it a built-in).  And by the time I'd read these
suggestions, I already had this patch basically done.  It keeps the C code
next to the XS and keeps everything in the Cwd namespace.  Files touched:

MANIFEST
lib/Cwd.pm
t/lib/cwd.t
ext/Cwd/Cwd.xs (new)
ext/Cwd/Makefile.PL (new)

I can easily chop the _cwdxs_fastcwd function out of Cwd.xs and move it
to (?:xs)?utils?\.c if you'd really like.  Let me know.

Cheers,
-Ben

-- 
signer: can't create ~/.sig: Channel number out of range

--- MANIFEST.orig	Fri Mar 30 12:39:25 2001
+++ MANIFEST	Fri Mar 30 12:40:05 2001
@@ -145,6 +145,8 @@
 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
--- lib/Cwd.pm.orig	Fri Mar 30 12:41:30 2001
+++ lib/Cwd.pm	Fri Mar 30 14:52:20 2001
@@ -121,50 +121,17 @@
     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;
 }
 
 
--- t/lib/cwd.t.orig	Fri Mar 30 12:56:10 2001
+++ t/lib/cwd.t	Fri Mar 30 13:04:53 2001
@@ -23,6 +23,10 @@
 	!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 =
--- /dev/null	Tue May  5 16:32:27 1998
+++ ext/Cwd/Cwd.xs	Fri Mar 30 14:06:53 2001
@@ -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;
--- /dev/null	Tue May  5 16:32:27 1998
+++ ext/Cwd/Makefile.PL	Fri Mar 30 12:51:35 2001
@@ -0,0 +1,5 @@
+use ExtUtils::MakeMaker;
+WriteMakefile(
+    NAME    => 'Cwd',
+    VERSION => '2.04',
+);


Thread Previous | Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About