File Coverage

ext/File-Glob/Glob.xs
Criterion Covered Total %
statement 128 172 74.4
branch n/a
condition n/a
subroutine n/a
total 128 172 74.4


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