This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
91b9f4d5f1428fe8b0865f45b27d188fb9527e4c
[perl5.git] / ext / File-Glob / Glob.xs
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 } my_cxt_t;
14
15 START_MY_CXT
16
17 #define GLOB_ERROR      (MY_CXT.x_GLOB_ERROR)
18
19 #include "const-c.inc"
20
21 #ifdef WIN32
22 #define errfunc         NULL
23 #else
24 static int
25 errfunc(const char *foo, int bar) {
26   PERL_UNUSED_ARG(foo);
27   return !(bar == EACCES || bar == ENOENT || bar == ENOTDIR);
28 }
29 #endif
30
31 MODULE = File::Glob             PACKAGE = File::Glob
32
33 int
34 GLOB_ERROR()
35     PREINIT:
36         dMY_CXT;
37     CODE:
38         RETVAL = GLOB_ERROR;
39     OUTPUT:
40         RETVAL
41
42 void
43 doglob(pattern,...)
44     char *pattern
45 PROTOTYPE: $;$
46 PREINIT:
47     glob_t pglob;
48     int i;
49     int retval;
50     int flags = 0;
51     SV *tmp;
52 PPCODE:
53     {
54         dMY_CXT;
55         dXSI32;
56
57         /* allow for optional flags argument */
58         if (items > 1) {
59             flags = (int) SvIV(ST(1));
60             /* remove unsupported flags */
61             flags &= ~(GLOB_APPEND | GLOB_DOOFFS | GLOB_ALTDIRFUNC | GLOB_MAGCHAR);
62         } else if (ix) {
63             flags = (int) SvIV(get_sv("File::Glob::DEFAULT_FLAGS", GV_ADD));
64         }
65
66         /* call glob */
67         memset(&pglob, 0, sizeof(glob_t));
68         retval = bsd_glob(pattern, flags, errfunc, &pglob);
69         GLOB_ERROR = retval;
70
71         /* return any matches found */
72         EXTEND(sp, pglob.gl_pathc);
73         for (i = 0; i < pglob.gl_pathc; i++) {
74             /* printf("# bsd_glob: %s\n", pglob.gl_pathv[i]); */
75             tmp = newSVpvn_flags(pglob.gl_pathv[i], strlen(pglob.gl_pathv[i]),
76                                  SVs_TEMP);
77             TAINT;
78             SvTAINT(tmp);
79             PUSHs(tmp);
80         }
81
82         bsd_globfree(&pglob);
83     }
84
85 BOOT:
86 {
87     CV *cv = newXS("File::Glob::bsd_glob", XS_File__Glob_doglob, __FILE__);
88     XSANY.any_i32 = 1;
89 }
90
91 BOOT:
92 {
93     MY_CXT_INIT;
94 }
95
96 INCLUDE: const-xs.inc