Commit | Line | Data |
---|---|---|
8e9c4baf NC |
1 | #define PERL_NO_GET_CONTEXT |
2 | ||
72b16652 GS |
3 | #include "EXTERN.h" |
4 | #include "perl.h" | |
5 | #include "XSUB.h" | |
6 | ||
7 | #include "bsd_glob.h" | |
8 | ||
df3728a2 | 9 | #define MY_CXT_KEY "File::Glob::_guts" XS_VERSION |
89ca4ac7 JH |
10 | |
11 | typedef struct { | |
12 | int x_GLOB_ERROR; | |
1bb8785a | 13 | HV * x_GLOB_ENTRIES; |
89ca4ac7 JH |
14 | } my_cxt_t; |
15 | ||
16 | START_MY_CXT | |
17 | ||
18 | #define GLOB_ERROR (MY_CXT.x_GLOB_ERROR) | |
72b16652 | 19 | |
1cb0fb50 | 20 | #include "const-c.inc" |
72b16652 GS |
21 | |
22 | #ifdef WIN32 | |
23 | #define errfunc NULL | |
24 | #else | |
f681a178 | 25 | static int |
72b16652 | 26 | errfunc(const char *foo, int bar) { |
c33e8be1 | 27 | PERL_UNUSED_ARG(foo); |
5f18268b | 28 | return !(bar == EACCES || bar == ENOENT || bar == ENOTDIR); |
72b16652 GS |
29 | } |
30 | #endif | |
31 | ||
1bb8785a FC |
32 | static void |
33 | doglob(pTHX_ const char *pattern, int flags) | |
34 | { | |
35 | dSP; | |
36 | glob_t pglob; | |
37 | int i; | |
38 | int retval; | |
39 | SV *tmp; | |
40 | { | |
41 | dMY_CXT; | |
42 | ||
43 | /* call glob */ | |
44 | memset(&pglob, 0, sizeof(glob_t)); | |
45 | retval = bsd_glob(pattern, flags, errfunc, &pglob); | |
46 | GLOB_ERROR = retval; | |
47 | ||
48 | /* return any matches found */ | |
49 | EXTEND(sp, pglob.gl_pathc); | |
50 | for (i = 0; i < pglob.gl_pathc; i++) { | |
51 | /* printf("# bsd_glob: %s\n", pglob.gl_pathv[i]); */ | |
52 | tmp = newSVpvn_flags(pglob.gl_pathv[i], strlen(pglob.gl_pathv[i]), | |
53 | SVs_TEMP); | |
54 | TAINT; | |
55 | SvTAINT(tmp); | |
56 | PUSHs(tmp); | |
57 | } | |
58 | PUTBACK; | |
59 | ||
60 | bsd_globfree(&pglob); | |
61 | } | |
62 | } | |
63 | ||
1bb8785a | 64 | static void |
1d6dcc39 | 65 | iterate(pTHX_ bool(*globber)(pTHX_ AV *entries, SV *patsv)) |
1bb8785a FC |
66 | { |
67 | dSP; | |
68 | dMY_CXT; | |
69 | ||
3ab888cf | 70 | SV * const cxixsv = POPs; |
1bb8785a FC |
71 | const char *cxixpv; |
72 | STRLEN cxixlen; | |
88b04955 | 73 | AV *entries; |
3ab888cf | 74 | U32 const gimme = GIMME_V; |
1bb8785a | 75 | SV *patsv = POPs; |
88b04955 | 76 | bool on_stack = FALSE; |
1bb8785a FC |
77 | |
78 | /* assume global context if not provided one */ | |
79 | SvGETMAGIC(cxixsv); | |
80 | if (SvOK(cxixsv)) cxixpv = SvPV_nomg(cxixsv, cxixlen); | |
81 | else cxixpv = "_G_", cxixlen = 3; | |
82 | ||
1bb8785a | 83 | if (!MY_CXT.x_GLOB_ENTRIES) MY_CXT.x_GLOB_ENTRIES = newHV(); |
1d6dcc39 | 84 | entries = (AV *)*(hv_fetch(MY_CXT.x_GLOB_ENTRIES, cxixpv, cxixlen, 1)); |
1bb8785a FC |
85 | |
86 | /* if we're just beginning, do it all first */ | |
1d6dcc39 | 87 | if (SvTYPE(entries) != SVt_PVAV) { |
88b04955 | 88 | PUTBACK; |
1d6dcc39 | 89 | on_stack = globber(aTHX_ entries, patsv); |
88b04955 FC |
90 | SPAGAIN; |
91 | } | |
92 | ||
93 | /* chuck it all out, quick or slow */ | |
88b04955 FC |
94 | if (gimme == G_ARRAY) { |
95 | if (!on_stack) { | |
96 | Copy(AvARRAY(entries), SP+1, AvFILLp(entries)+1, SV *); | |
97 | SP += AvFILLp(entries)+1; | |
98 | } | |
88b04955 FC |
99 | /* No G_DISCARD here! It will free the stack items. */ |
100 | hv_delete(MY_CXT.x_GLOB_ENTRIES, cxixpv, cxixlen, 0); | |
101 | } | |
102 | else { | |
103 | if (AvFILLp(entries) + 1) { | |
88b04955 FC |
104 | mPUSHs(av_shift(entries)); |
105 | } | |
106 | else { | |
107 | /* return undef for EOL */ | |
88b04955 FC |
108 | hv_delete(MY_CXT.x_GLOB_ENTRIES, cxixpv, cxixlen, G_DISCARD); |
109 | PUSHs(&PL_sv_undef); | |
110 | } | |
111 | } | |
112 | PUTBACK; | |
113 | } | |
114 | ||
7a26772a FC |
115 | /* returns true if the items are on the stack already, but only in |
116 | list context */ | |
88b04955 | 117 | static bool |
1d6dcc39 | 118 | csh_glob(pTHX_ AV *entries, SV *patsv) |
88b04955 FC |
119 | { |
120 | dSP; | |
1bb8785a FC |
121 | const char *pat; |
122 | AV *patav = NULL; | |
123 | const char *patend; | |
88b04955 | 124 | const char *s = NULL; |
1bb8785a FC |
125 | const char *piece = NULL; |
126 | SV *word = NULL; | |
127 | int const flags = | |
128 | (int)SvIV(get_sv("File::Glob::DEFAULT_FLAGS", GV_ADD)); | |
129 | bool is_utf8; | |
88b04955 FC |
130 | STRLEN len; |
131 | U32 const gimme = GIMME_V; | |
1bb8785a FC |
132 | |
133 | /* glob without args defaults to $_ */ | |
134 | SvGETMAGIC(patsv); | |
135 | if ( | |
136 | !SvOK(patsv) | |
137 | && (patsv = DEFSV, SvGETMAGIC(patsv), !SvOK(patsv)) | |
138 | ) | |
139 | pat = "", len = 0, is_utf8 = 0; | |
140 | else pat = SvPV_nomg(patsv,len), is_utf8 = !!SvUTF8(patsv); | |
141 | patend = pat + len; | |
142 | ||
143 | /* extract patterns */ | |
1bb8785a FC |
144 | s = pat-1; |
145 | while (++s < patend) { | |
146 | switch (*s) { | |
147 | case '\'': | |
148 | case '"' : | |
149 | { | |
150 | bool found = FALSE; | |
e1621fc9 | 151 | const char quote = *s; |
1bb8785a FC |
152 | if (!word) { |
153 | word = newSVpvs(""); | |
154 | if (is_utf8) SvUTF8_on(word); | |
155 | } | |
156 | if (piece) sv_catpvn(word, piece, s-piece); | |
157 | piece = s+1; | |
f89f9e93 | 158 | while (++s < patend) |
e1621fc9 FC |
159 | if (*s == '\\') { |
160 | s++; | |
161 | /* If the backslash is here to escape a quote, | |
162 | obliterate it. */ | |
163 | if (s < patend && *s == quote) | |
164 | sv_catpvn(word, piece, s-piece-1), piece = s; | |
165 | } | |
166 | else if (*s == quote) { | |
1bb8785a FC |
167 | sv_catpvn(word, piece, s-piece); |
168 | piece = NULL; | |
169 | found = TRUE; | |
170 | break; | |
171 | } | |
172 | if (!found) { /* unmatched quote */ | |
173 | /* Give up on tokenisation and treat the whole string | |
174 | as a single token, but with whitespace stripped. */ | |
175 | piece = pat; | |
176 | while (isSPACE(*pat)) pat++; | |
177 | while (isSPACE(*(patend-1))) patend--; | |
178 | /* bsd_glob expects a trailing null, but we cannot mod- | |
179 | ify the original */ | |
180 | if (patend < SvEND(patsv)) { | |
181 | if (word) sv_setpvn(word, pat, patend-pat); | |
182 | else | |
183 | word = newSVpvn_flags( | |
184 | pat, patend-pat, SVf_UTF8*is_utf8 | |
185 | ); | |
186 | piece = NULL; | |
187 | } | |
188 | else { | |
189 | if (word) SvREFCNT_dec(word), word=NULL; | |
190 | piece = pat; | |
191 | s = patend; | |
192 | } | |
193 | goto end_of_parsing; | |
194 | } | |
195 | break; | |
196 | } | |
e1621fc9 FC |
197 | case '\\': |
198 | if (!piece) piece = s; | |
199 | s++; | |
200 | /* If the backslash is here to escape a quote, | |
201 | obliterate it. */ | |
202 | if (s < patend && (*s == '"' || *s == '\'')) { | |
203 | if (!word) { | |
204 | word = newSVpvn(piece,s-piece-1); | |
205 | if (is_utf8) SvUTF8_on(word); | |
206 | } | |
207 | else sv_catpvn(word, piece, s-piece-1); | |
208 | piece = s; | |
209 | } | |
210 | break; | |
1bb8785a FC |
211 | default: |
212 | if (isSPACE(*s)) { | |
213 | if (piece) { | |
214 | if (!word) { | |
215 | word = newSVpvn(piece,s-piece); | |
216 | if (is_utf8) SvUTF8_on(word); | |
217 | } | |
218 | else sv_catpvn(word, piece, s-piece); | |
219 | } | |
220 | if (!word) break; | |
221 | if (!patav) patav = (AV *)sv_2mortal((SV *)newAV()); | |
222 | av_push(patav, word); | |
223 | word = NULL; | |
224 | piece = NULL; | |
225 | } | |
226 | else if (!piece) piece = s; | |
227 | break; | |
228 | } | |
229 | } | |
230 | end_of_parsing: | |
231 | ||
1d6dcc39 | 232 | assert(SvTYPE(entries) != SVt_PVAV); |
1bb8785a FC |
233 | sv_upgrade((SV *)entries, SVt_PVAV); |
234 | ||
235 | if (patav) { | |
236 | I32 items = AvFILLp(patav) + 1; | |
237 | SV **svp = AvARRAY(patav); | |
238 | while (items--) { | |
239 | PUSHMARK(SP); | |
240 | PUTBACK; | |
241 | doglob(aTHX_ SvPVXx(*svp++), flags); | |
242 | SPAGAIN; | |
243 | { | |
244 | dMARK; | |
245 | dORIGMARK; | |
246 | while (++MARK <= SP) | |
247 | av_push(entries, SvREFCNT_inc_simple_NN(*MARK)); | |
248 | SP = ORIGMARK; | |
249 | } | |
250 | } | |
251 | } | |
252 | /* piece is set at this point if there is no trailing whitespace. | |
253 | It is the beginning of the last token or quote-delimited | |
254 | piece thereof. word is set at this point if the last token has | |
255 | multiple quoted pieces. */ | |
256 | if (piece || word) { | |
257 | if (word) { | |
258 | if (piece) sv_catpvn(word, piece, s-piece); | |
259 | piece = SvPVX(word); | |
260 | } | |
261 | PUSHMARK(SP); | |
262 | PUTBACK; | |
263 | doglob(aTHX_ piece, flags); | |
264 | if (word) SvREFCNT_dec(word); | |
265 | SPAGAIN; | |
266 | { | |
267 | dMARK; | |
268 | dORIGMARK; | |
1bb8785a | 269 | /* short-circuit here for a fairly common case */ |
88b04955 | 270 | if (!patav && gimme == G_ARRAY) { PUTBACK; return TRUE; } |
c0d74586 FC |
271 | while (++MARK <= SP) |
272 | av_push(entries, SvREFCNT_inc_simple_NN(*MARK)); | |
1bb8785a FC |
273 | |
274 | SP = ORIGMARK; | |
275 | } | |
276 | } | |
88b04955 FC |
277 | PUTBACK; |
278 | return FALSE; | |
279 | } | |
1bb8785a | 280 | |
88b04955 FC |
281 | static void |
282 | csh_glob_iter(pTHX) | |
283 | { | |
284 | iterate(aTHX_ csh_glob); | |
1bb8785a FC |
285 | } |
286 | ||
f4cbf990 FC |
287 | /* wrapper around doglob that can be passed to the iterator */ |
288 | static bool | |
1d6dcc39 | 289 | doglob_iter_wrapper(pTHX_ AV *entries, SV *patsv) |
f4cbf990 FC |
290 | { |
291 | dSP; | |
292 | const char *pattern; | |
293 | int const flags = | |
294 | (int)SvIV(get_sv("File::Glob::DEFAULT_FLAGS", GV_ADD)); | |
f4cbf990 FC |
295 | |
296 | SvGETMAGIC(patsv); | |
297 | if ( | |
298 | !SvOK(patsv) | |
299 | && (patsv = DEFSV, SvGETMAGIC(patsv), !SvOK(patsv)) | |
300 | ) | |
301 | pattern = ""; | |
302 | else pattern = SvPV_nomg_nolen(patsv); | |
303 | ||
304 | PUSHMARK(SP); | |
305 | PUTBACK; | |
306 | doglob(aTHX_ pattern, flags); | |
307 | SPAGAIN; | |
308 | { | |
309 | dMARK; | |
310 | dORIGMARK; | |
311 | if (GIMME_V == G_ARRAY) { PUTBACK; return TRUE; } | |
f4cbf990 FC |
312 | sv_upgrade((SV *)entries, SVt_PVAV); |
313 | while (++MARK <= SP) | |
314 | av_push(entries, SvREFCNT_inc_simple_NN(*MARK)); | |
315 | SP = ORIGMARK; | |
316 | } | |
317 | return FALSE; | |
318 | } | |
319 | ||
72b16652 GS |
320 | MODULE = File::Glob PACKAGE = File::Glob |
321 | ||
b84cd0b1 NC |
322 | int |
323 | GLOB_ERROR() | |
324 | PREINIT: | |
325 | dMY_CXT; | |
326 | CODE: | |
327 | RETVAL = GLOB_ERROR; | |
328 | OUTPUT: | |
329 | RETVAL | |
330 | ||
72b16652 | 331 | void |
960ddb65 | 332 | bsd_glob(pattern,...) |
72b16652 | 333 | char *pattern |
72b16652 GS |
334 | PREINIT: |
335 | glob_t pglob; | |
336 | int i; | |
337 | int retval; | |
338 | int flags = 0; | |
339 | SV *tmp; | |
340 | PPCODE: | |
341 | { | |
342 | /* allow for optional flags argument */ | |
343 | if (items > 1) { | |
344 | flags = (int) SvIV(ST(1)); | |
3c97495f CB |
345 | /* remove unsupported flags */ |
346 | flags &= ~(GLOB_APPEND | GLOB_DOOFFS | GLOB_ALTDIRFUNC | GLOB_MAGCHAR); | |
960ddb65 | 347 | } else { |
28cd8e1d | 348 | flags = (int) SvIV(get_sv("File::Glob::DEFAULT_FLAGS", GV_ADD)); |
72b16652 | 349 | } |
1bb8785a FC |
350 | |
351 | PUTBACK; | |
352 | doglob(aTHX_ pattern, flags); | |
353 | SPAGAIN; | |
354 | } | |
72b16652 | 355 | |
1bb8785a FC |
356 | PROTOTYPES: DISABLE |
357 | void | |
358 | csh_glob(...) | |
359 | PPCODE: | |
360 | /* For backward-compatibility with the original Perl function, we sim- | |
361 | * ply take the first two arguments, regardless of how many there are. | |
362 | */ | |
363 | if (items >= 2) SP += 2; | |
364 | else { | |
365 | SP += items; | |
366 | XPUSHs(&PL_sv_undef); | |
367 | if (!items) XPUSHs(&PL_sv_undef); | |
72b16652 | 368 | } |
1bb8785a | 369 | PUTBACK; |
88b04955 | 370 | csh_glob_iter(aTHX); |
1bb8785a | 371 | SPAGAIN; |
72b16652 | 372 | |
f4cbf990 FC |
373 | void |
374 | bsd_glob_override(...) | |
375 | PPCODE: | |
376 | if (items >= 2) SP += 2; | |
377 | else { | |
378 | SP += items; | |
379 | XPUSHs(&PL_sv_undef); | |
380 | if (!items) XPUSHs(&PL_sv_undef); | |
381 | } | |
382 | PUTBACK; | |
383 | iterate(aTHX_ doglob_iter_wrapper); | |
384 | SPAGAIN; | |
385 | ||
28cd8e1d NC |
386 | BOOT: |
387 | { | |
d67594ff FC |
388 | #ifndef PERL_EXTERNAL_GLOB |
389 | /* Don’t do this at home! The globhook interface is highly volatile. */ | |
88b04955 | 390 | PL_globhook = csh_glob_iter; |
d67594ff | 391 | #endif |
bcd258b8 | 392 | } |
28cd8e1d | 393 | |
bcd258b8 NC |
394 | BOOT: |
395 | { | |
28cd8e1d | 396 | MY_CXT_INIT; |
1bb8785a FC |
397 | { |
398 | dMY_CXT; | |
6a606603 | 399 | MY_CXT.x_GLOB_ENTRIES = NULL; |
1bb8785a | 400 | } |
28cd8e1d NC |
401 | } |
402 | ||
1cb0fb50 | 403 | INCLUDE: const-xs.inc |