X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FCwd%2FCwd.xs;h=7b367168f869d4001dfab3ed2b6e3356e3a4dd3b;hb=f22d8e4b6ac8b32788591ab647fd40e18ea984f2;hp=cc63a5b3b3ad849eddd3b11bdbdc339a4d8610d8;hpb=2ae52c40fdb2498667a57e8f5e2d6532b0aad34f;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/Cwd/Cwd.xs b/ext/Cwd/Cwd.xs index cc63a5b..7b36716 100644 --- a/ext/Cwd/Cwd.xs +++ b/ext/Cwd/Cwd.xs @@ -2,238 +2,36 @@ #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; - -#ifdef VOID_CLOSEDIR - PerlDir_close(dir); -#else - if (PerlDir_close(dir) < 0) { - Safefree(names); - return FALSE; - } -#endif - } - - 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]); - } +MODULE = Cwd PACKAGE = Cwd - 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"); +PROTOTYPES: ENABLE - Safefree(names); - return(path); +void +fastcwd() +PPCODE: +{ + dXSTARG; + sv_getcwd(TARG); + XSprePUSH; PUSHTARG; } -char * -_cwdxs_abs_path(char *start) +void +abs_path(svpath=Nullsv) + SV *svpath +PPCODE: { - DIR *parent; - Direntry_t *dp; - char dotdots[MAXPATHLEN] = "", dir[MAXPATHLEN] = ""; - char name[FILENAME_MAX] = ""; - char *cwd; - int namelen; - struct stat cst, pst, tst; - - if (PerlLIO_stat(start, &cst) < 0) { - warn("stat(%s): %s", start, Strerror(errno)); - return FALSE; - } + dXSTARG; + char *path; + STRLEN len; - Newz(0, cwd, MAXPATHLEN, char); - Copy(start, dotdots, strlen(start), char); - - for (;;) { - strcat(dotdots, "/.."); - StructCopy(&cst, &pst, struct stat); - - if (PerlLIO_stat(dotdots, &cst) < 0) { - Safefree(cwd); - warn("stat(%s): %s", dotdots, Strerror(errno)); - return FALSE; + if (svpath) { + path = SvPV(svpath, len); } - - if (pst.st_dev == cst.st_dev && pst.st_ino == cst.st_ino) { - /* We've reached the root: previous is same as current */ - break; - } else { - /* Scan through the dir looking for name of previous */ - if (!(parent = PerlDir_open(dotdots))) { - Safefree(cwd); - warn("opendir(%s): %s", dotdots, Strerror(errno)); - return FALSE; - } - - while ((dp = PerlDir_read(parent)) != NULL) { - if (strEQ(dp->d_name, ".")) - continue; - if (strEQ(dp->d_name, "..")) - continue; - - Zero(name, FILENAME_MAX, char); - Copy(dotdots, name, strlen(dotdots), char); - *(name + strlen(dotdots)) = '/'; - strcat(name, dp->d_name); - - if (PerlLIO_lstat(name, &tst) < 0) { - Safefree(cwd); - PerlDir_close(parent); - warn("lstat(%s): %s", name, Strerror(errno)); - return FALSE; - } - - if (tst.st_dev == pst.st_dev && tst.st_ino == pst.st_ino) - break; - } - -#ifdef DIRNAMLEN - namelen = dp->d_namlen; -#else - namelen = strlen(dp->d_name); -#endif - Move(cwd, cwd + namelen + 1, strlen(cwd), char); - Copy(dp->d_name, cwd + 1, namelen, char); -#ifdef VOID_CLOSEDIR - PerlDir_close(dir); -#else - if (PerlDir_close(parent) < 0) { - warn("closedir(%s): %s", dotdots, Strerror(errno)); - Safefree(cwd); - return FALSE; - } -#endif - *cwd = '/'; + else { + path = "."; + len = 1; } - } - return cwd; + sv_realpath(TARG, path, len); + XSprePUSH; PUSHTARG; } - - -MODULE = Cwd PACKAGE = Cwd - -PROTOTYPES: ENABLE - -char * -_fastcwd() -PPCODE: - char * buf; - buf = _cwdxs_fastcwd(); - if (buf) { - PUSHs(sv_2mortal(newSVpv(buf, 0))); - Safefree(buf); - } - else - XSRETURN_UNDEF; - -char * -_abs_path(start = ".") - char * start -PREINIT: - char * buf; -PPCODE: - buf = _cwdxs_abs_path(start); - if (buf) { - PUSHs(sv_2mortal(newSVpv(buf, 0))); - Safefree(buf); - } - else - XSRETURN_UNDEF;