Commit | Line | Data |
0d2079fa |
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 | |
acf4de66 |
124 | PROTOTYPES: ENABLE |
125 | |
0d2079fa |
126 | char * |
127 | _fastcwd() |
128 | PPCODE: |
129 | char * buf; |
130 | buf = _cwdxs_fastcwd(); |
131 | if (buf) { |
132 | PUSHs(sv_2mortal(newSVpv(buf, 0))); |
133 | Safefree(buf); |
134 | } |
135 | else |
136 | XSRETURN_UNDEF; |