[PATCH] CwdXS, Take 2

Hi Jarkko,

This patch is take 2 of implementing Cwd in XS.  It replaces the patch I
sent last week.  This patch resolves most of the issues related to the
last patch, so I think it's ready for inclusion.  Let me know.

Patch is against perl@9452.

Cheers,
-Ben

-- 
signer: can't create ~/.sig: File name too long

--- MANIFEST.orig	Thu Mar 29 14:31:38 2001
+++ MANIFEST	Thu Mar 29 14:33:11 2001
@@ -145,6 +145,9 @@
 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/CwdXS/CwdXS.pm		CwdXS extension Perl module
+ext/Cwd/CwdXS/CwdXS.xs		CwdXS extension external subroutines
+ext/Cwd/CwdXS/Makefile.PL	CwdXS extension makefile writer
 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
--- t/lib/cwd.t.orig	Thu Mar 29 14:36:25 2001
+++ t/lib/cwd.t	Thu Mar 29 15:03:41 2001
@@ -7,6 +7,7 @@
 
 use Config;
 use Cwd;
+use Cwd::CwdXS;            # not normally needed, but @INC = ("../lib")
 use strict;
 use warnings;
 
@@ -40,9 +41,13 @@
 	my $getcwd     = getcwd;
 	my $fastcwd    = fastcwd;
 	my $fastgetcwd = fastgetcwd;
+	print "# expected $start, got $cwd\n";
 	print +($cwd        eq $start ? "" : "not "), "ok 3\n";
+	print "# expected $start, got $getcwd\n";
 	print +($getcwd     eq $start ? "" : "not "), "ok 4\n";
+	print "# expected $start, got $fastcwd\n";
 	print +($fastcwd    eq $start ? "" : "not "), "ok 5\n";
+	print "# expected $start, got $fastgetcwd\n";
 	print +($fastgetcwd eq $start ? "" : "not "), "ok 6\n";
     }
 } else {
@@ -62,9 +67,13 @@
 my $fastcwd    = fastcwd;
 my $fastgetcwd = fastgetcwd;
 my $want = "t/pteerslt/path/to/a/dir";
+print "# expected $want, got $cwd\n";
 print +($cwd        =~ m|$want$| ? "" : "not "), "ok 7\n";
+print "# expected end with $want, got $getcwd\n";
 print +($getcwd     =~ m|$want$| ? "" : "not "), "ok 8\n";
+print "# expected end with $want, got $fastcwd\n";
 print +($fastcwd    =~ m|$want$| ? "" : "not "), "ok 9\n";
+print "# expected end with $want, got $fastgetcwd\n";
 print +($fastgetcwd =~ m|$want$| ? "" : "not "), "ok 10\n";
 
 # Cwd::chdir should also update $ENV{PWD}
--- /dev/null	Tue May  5 16:32:27 1998
+++ ext/Cwd/CwdXS/CwdXS.pm	Thu Mar 29 14:36:04 2001
@@ -0,0 +1,26 @@
+package Cwd::CwdXS;
+require 5.6.0;
+use strict;
+
+our $VERSION;
+$VERSION = '0.10';
+
+use XSLoader ();
+XSLoader::load "Cwd::CwdXS", $VERSION;
+
+=head1 NAME
+
+Cwd::CwdXS - XS implementation of fastcwd()
+
+=head1 SYNOPSIS
+
+  use Cwd::CwdXS;
+  $dir = Cwd::CwdXS::fastcwd();
+
+=head1 DESCRIPTION
+
+This module provides an XS implementation of the fastcwd() subroutine
+and is used internally by the Cwd module.  See the L<Cwd> for further
+information.
+
+=cut
--- /dev/null	Tue May  5 16:32:27 1998
+++ ext/Cwd/CwdXS/CwdXS.xs	Thu Mar 29 15:26:52 2001
@@ -0,0 +1,135 @@
+#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, char);
+  for (j = i - 1; j >= 0; --j) {
+    *(path + k) = '/';
+    Copy(names[j], path + k + 1, strlen(names[j]), char);
+    k = k + strlen(names[j]) + 1;
+    Safefree(names[j]);
+  }
+  *(path + pathlen) = '\0';
+
+  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::CwdXS		PACKAGE = Cwd::CwdXS
+
+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/CwdXS/Makefile.PL	Thu Mar 29 14:36:05 2001
@@ -0,0 +1,7 @@
+use ExtUtils::MakeMaker;
+use Config;
+WriteMakefile(
+    NAME	=> 'Cwd::CwdXS',
+    MAN3PODS 	=> {}, 	# Pods will be built by installman.
+    VERSION_FROM => 'CwdXS.pm', 
+);

• [PATCH] CwdXS, Take 2 by Benjamin Sugars
• Re: [PATCH] CwdXS, Take 2 by Jarkko Hietaniemi
• Re: [PATCH] CwdXS, Take 2 by Benjamin Sugars
• Re: [PATCH] CwdXS, Take 2 by Gurusamy Sarathy
• Re: [PATCH] CwdXS, Take 2 by Jarkko Hietaniemi
• Re: [PATCH] CwdXS, Take 2 by Benjamin Sugars
• Re: [PATCH] CwdXS, Take 2 by Jarkko Hietaniemi
• Re: [PATCH] CwdXS, Take 2 by Benjamin Sugars