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     if (PerlDir_close(dir) < 0) {
  89       Safefree(names);
  90       return FALSE;
  91     }
  92   }
  93
  94   Newz(0, path, pathlen + 1, char);
  95   for (j = i - 1; j >= 0; j--) {
  96     *(path + k) = '/';
  97     Copy(names[j], path + k + 1, strlen(names[j]) + 1, char);
  98     k = k + strlen(names[j]) + 1;
  99     Safefree(names[j]);
 100   }
 101
 102   if (PerlDir_chdir(path) < 0) {
 103     Safefree(names);
 104     Safefree(path);
 105     return FALSE;
 106   }
 107   if (PerlLIO_stat(".", &statbuf) < 0) {
 108     Safefree(names);
 109     Safefree(path);
 110     return FALSE;
 111   }
 112   cdev = statbuf.st_dev;
 113   cino = statbuf.st_ino;
 114   if (cdev != orig_cdev || cino != orig_cino)
 115     Perl_croak(aTHX_ "Unstable directory path, current directory changed unexpectedly");
 116
 117   Safefree(names);
 118   return(path);
 119 }
 120
 121
 122 MODULE = Cwd            PACKAGE = Cwd
 123
 124 char *
 125 _fastcwd()
 126 PPCODE:
 127     char * buf;
 128     buf = _cwdxs_fastcwd();
 129     if (buf) {
 130         PUSHs(sv_2mortal(newSVpv(buf, 0)));
 131         Safefree(buf);
 132     }
 133     else
 134         XSRETURN_UNDEF;