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