ext/Cwd/Cwd.xs

   1 #include "EXTERN.h"
   2 #include "perl.h"
   3 #include "XSUB.h"
   4
   5 /* Originally written in Perl by John Bazik; rewritten in C by Ben Sugars.
   6  * Comments from the orignal:
   7  *     This is a faster version of getcwd.  It's also more dangerous
   8  *     because you might chdir out of a directory that you can't chdir
   9  *     back into. */
  10 char *
  11 _cwdxs_fastcwd(void)
  12 {
  13 /* XXX Should we just use getcwd(3) if available? */
  14   struct stat statbuf;
  15   int orig_cdev, orig_cino, cdev, cino, odev, oino, tdev, tino;
  16   int i = 0, j = 0, k = 0, ndirs = 16, pathlen = 0, namelen;
  17   DIR *dir;
  18   Direntry_t *dp;
  19   char **names, *path;
  20
  21   Newz(0, names, ndirs, char*);
  22
  23   if (PerlLIO_lstat(".", &statbuf) < 0) {
  24     Safefree(names);
  25     return FALSE;
  26   }
  27   orig_cdev = statbuf.st_dev;
  28   orig_cino = statbuf.st_ino;
  29   cdev = orig_cdev;
  30   cino = orig_cino;
  31   for (;;) {
  32     odev = cdev;
  33     oino = cino;
  34
  35     if (PerlDir_chdir("..") < 0) {
  36       Safefree(names);
  37       return FALSE;
  38     }
  39     if (PerlLIO_stat(".", &statbuf) < 0) {
  40       Safefree(names);
  41       return FALSE;
  42     }
  43     cdev = statbuf.st_dev;
  44     cino = statbuf.st_ino;
  45     if (odev == cdev && oino == cino)
  46       break;
  47
  48     if (!(dir = PerlDir_open("."))) {
  49       Safefree(names);
  50       return FALSE;
  51     }
  52
  53     while ((dp = PerlDir_read(dir)) != NULL) {
  54       if (PerlLIO_lstat(dp->d_name, &statbuf) < 0) {
  55         Safefree(names);
  56         return FALSE;
  57       }
  58       if (strEQ(dp->d_name, "."))
  59         continue;
  60       if (strEQ(dp->d_name, ".."))
  61         continue;
  62       tdev = statbuf.st_dev;
  63       tino = statbuf.st_ino;
  64       if (tino == oino && tdev == odev)
  65         break;
  66     }
  67
  68     if (!dp) {
  69       Safefree(names);
  70       return FALSE;
  71     }
  72
  73     if (i >= ndirs) {
  74       ndirs += 16;
  75       Renew(names, ndirs, char*);
  76     }
  77 #ifdef DIRNAMLEN
  78     namelen = dp->d_namlen;
  79 #else
  80     namelen = strlen(dp->d_name);
  81 #endif
  82     Newz(0, *(names + i), namelen + 1, char);
  83     Copy(dp->d_name, *(names + i), namelen, char);
  84     *(names[i] + namelen) = '\0';
  85     pathlen += (namelen + 1);
  86     ++i;
  87
  88 #ifdef VOID_CLOSEDIR
  89     PerlDir_close(dir);
  90 #else
  91     if (PerlDir_close(dir) < 0) {
  92       Safefree(names);
  93       return FALSE;
  94     }
  95 #endif
  96   }
  97
  98   Newz(0, path, pathlen + 1, char);
  99   for (j = i - 1; j >= 0; j--) {
 100     *(path + k) = '/';
 101     Copy(names[j], path + k + 1, strlen(names[j]) + 1, char);
 102     k = k + strlen(names[j]) + 1;
 103     Safefree(names[j]);
 104   }
 105
 106   if (PerlDir_chdir(path) < 0) {
 107     Safefree(names);
 108     Safefree(path);
 109     return FALSE;
 110   }
 111   if (PerlLIO_stat(".", &statbuf) < 0) {
 112     Safefree(names);
 113     Safefree(path);
 114     return FALSE;
 115   }
 116   cdev = statbuf.st_dev;
 117   cino = statbuf.st_ino;
 118   if (cdev != orig_cdev || cino != orig_cino)
 119     Perl_croak(aTHX_ "Unstable directory path, current directory changed unexpectedly");
 120
 121   Safefree(names);
 122   return(path);
 123 }
 124
 125
 126 MODULE = Cwd            PACKAGE = Cwd
 127
 128 PROTOTYPES: ENABLE
 129
 130 char *
 131 _fastcwd()
 132 PPCODE:
 133     char * buf;
 134     buf = _cwdxs_fastcwd();
 135     if (buf) {
 136         PUSHs(sv_2mortal(newSVpv(buf, 0)));
 137         Safefree(buf);
 138     }
 139     else
 140         XSRETURN_UNDEF;