This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
integrate changes#9377,9385,9401 from mainline
[perl5.git] / ext / File / Glob / Glob.xs
CommitLineData
72b16652
GS
1#include "EXTERN.h"
2#include "perl.h"
3#include "XSUB.h"
4
5#include "bsd_glob.h"
6
7static int GLOB_ERROR = 0;
8
9static int
10not_here(char *s)
11{
12 croak("%s not implemented on this architecture", s);
13 return -1;
14}
15
16
17static double
18constant(char *name, int arg)
19{
20 errno = 0;
21 if (strlen(name) <= 5)
22 goto not_there;
23 switch (*(name+5)) {
24 case 'A':
25 if (strEQ(name, "GLOB_ABEND"))
26#ifdef GLOB_ABEND
27 return GLOB_ABEND;
28#else
29 goto not_there;
30#endif
1086ad23 31 if (strEQ(name, "GLOB_ALPHASORT"))
8549c3fc 32#ifdef GLOB_ALPHASORT
1086ad23
GS
33 return GLOB_ALPHASORT;
34#else
35 goto not_there;
36#endif
72b16652
GS
37 if (strEQ(name, "GLOB_ALTDIRFUNC"))
38#ifdef GLOB_ALTDIRFUNC
39 return GLOB_ALTDIRFUNC;
40#else
41 goto not_there;
42#endif
43 break;
44 case 'B':
45 if (strEQ(name, "GLOB_BRACE"))
46#ifdef GLOB_BRACE
47 return GLOB_BRACE;
48#else
49 goto not_there;
50#endif
51 break;
52 case 'C':
53 break;
54 case 'D':
55 break;
56 case 'E':
57 if (strEQ(name, "GLOB_ERR"))
58#ifdef GLOB_ERR
59 return GLOB_ERR;
60#else
61 goto not_there;
62#endif
63 if (strEQ(name, "GLOB_ERROR"))
64 return GLOB_ERROR;
65 break;
66 case 'F':
67 break;
68 case 'G':
69 break;
70 case 'H':
71 break;
72 case 'I':
73 break;
74 case 'J':
75 break;
76 case 'K':
77 break;
78 case 'L':
79 break;
80 case 'M':
81 if (strEQ(name, "GLOB_MARK"))
82#ifdef GLOB_MARK
83 return GLOB_MARK;
84#else
85 goto not_there;
86#endif
87 break;
88 case 'N':
220398a0
PM
89 if (strEQ(name, "GLOB_NOCASE"))
90#ifdef GLOB_NOCASE
91 return GLOB_NOCASE;
92#else
93 goto not_there;
94#endif
72b16652
GS
95 if (strEQ(name, "GLOB_NOCHECK"))
96#ifdef GLOB_NOCHECK
97 return GLOB_NOCHECK;
98#else
99 goto not_there;
100#endif
101 if (strEQ(name, "GLOB_NOMAGIC"))
102#ifdef GLOB_NOMAGIC
103 return GLOB_NOMAGIC;
104#else
105 goto not_there;
106#endif
107 if (strEQ(name, "GLOB_NOSORT"))
108#ifdef GLOB_NOSORT
109 return GLOB_NOSORT;
110#else
111 goto not_there;
112#endif
113 if (strEQ(name, "GLOB_NOSPACE"))
114#ifdef GLOB_NOSPACE
115 return GLOB_NOSPACE;
116#else
117 goto not_there;
118#endif
119 break;
120 case 'O':
121 break;
122 case 'P':
123 break;
124 case 'Q':
125 if (strEQ(name, "GLOB_QUOTE"))
126#ifdef GLOB_QUOTE
127 return GLOB_QUOTE;
128#else
129 goto not_there;
130#endif
131 break;
132 case 'R':
133 break;
134 case 'S':
135 break;
136 case 'T':
137 if (strEQ(name, "GLOB_TILDE"))
138#ifdef GLOB_TILDE
139 return GLOB_TILDE;
140#else
141 goto not_there;
142#endif
143 break;
144 case 'U':
145 break;
146 case 'V':
147 break;
148 case 'W':
149 break;
150 case 'X':
151 break;
152 case 'Y':
153 break;
154 case 'Z':
155 break;
156 }
157 errno = EINVAL;
158 return 0;
159
160not_there:
161 errno = ENOENT;
162 return 0;
163}
164
165#ifdef WIN32
166#define errfunc NULL
167#else
168int
169errfunc(const char *foo, int bar) {
170 return !(bar == ENOENT || bar == ENOTDIR);
171}
172#endif
173
174MODULE = File::Glob PACKAGE = File::Glob
175
176void
177doglob(pattern,...)
178 char *pattern
e3de7a34 179PROTOTYPE: $;$
72b16652
GS
180PREINIT:
181 glob_t pglob;
182 int i;
183 int retval;
184 int flags = 0;
185 SV *tmp;
186PPCODE:
187 {
188 /* allow for optional flags argument */
189 if (items > 1) {
190 flags = (int) SvIV(ST(1));
191 }
192
193 /* call glob */
194 retval = bsd_glob(pattern, flags, errfunc, &pglob);
195 GLOB_ERROR = retval;
196
197 /* return any matches found */
198 EXTEND(sp, pglob.gl_pathc);
199 for (i = 0; i < pglob.gl_pathc; i++) {
200 /* printf("# bsd_glob: %s\n", pglob.gl_pathv[i]); */
201 tmp = sv_2mortal(newSVpvn(pglob.gl_pathv[i],
202 strlen(pglob.gl_pathv[i])));
203 TAINT;
204 SvTAINT(tmp);
205 PUSHs(tmp);
206 }
207
208 bsd_globfree(&pglob);
209 }
210
211double
212constant(name,arg)
213 char *name
214 int arg
e3de7a34 215PROTOTYPE: $$