[perl5.git] / ext / File-Glob / Glob.xs

#define PERL_NO_GET_CONTEXT

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "bsd_glob.h"

#define MY_CXT_KEY "File::Glob::_guts" XS_VERSION

typedef struct {
    int		x_GLOB_ERROR;
    HV *	x_GLOB_ENTRIES;
} my_cxt_t;

START_MY_CXT

#define GLOB_ERROR	(MY_CXT.x_GLOB_ERROR)

#include "const-c.inc"

#ifdef WIN32
#define errfunc		NULL
#else
static int
errfunc(const char *foo, int bar) {
  PERL_UNUSED_ARG(foo);
  return !(bar == EACCES || bar == ENOENT || bar == ENOTDIR);
}
#endif

static void
doglob(pTHX_ const char *pattern, int flags)
{
    dSP;
    glob_t pglob;
    int i;
    int retval;
    SV *tmp;
    {
	dMY_CXT;

	/* call glob */
	memset(&pglob, 0, sizeof(glob_t));
	retval = bsd_glob(pattern, flags, errfunc, &pglob);
	GLOB_ERROR = retval;

	/* return any matches found */
	EXTEND(sp, pglob.gl_pathc);
	for (i = 0; i < pglob.gl_pathc; i++) {
	    /* printf("# bsd_glob: %s\n", pglob.gl_pathv[i]); */
	    tmp = newSVpvn_flags(pglob.gl_pathv[i], strlen(pglob.gl_pathv[i]),
				 SVs_TEMP);
	    TAINT;
	    SvTAINT(tmp);
	    PUSHs(tmp);
	}
	PUTBACK;

	bsd_globfree(&pglob);
    }
}

static void
iterate(pTHX_ bool(*globber)(pTHX_ AV *entries, SV *patsv))
{
    dSP;
    dMY_CXT;

    const char * const cxixpv = (char *)&PL_op;
    STRLEN const cxixlen = sizeof(OP *);
    AV *entries;
    U32 const gimme = GIMME_V;
    SV *patsv = POPs;
    bool on_stack = FALSE;

    if (!MY_CXT.x_GLOB_ENTRIES) MY_CXT.x_GLOB_ENTRIES = newHV();
    entries = (AV *)*(hv_fetch(MY_CXT.x_GLOB_ENTRIES, cxixpv, cxixlen, 1));

    /* if we're just beginning, do it all first */
    if (SvTYPE(entries) != SVt_PVAV) {
	PUTBACK;
	on_stack = globber(aTHX_ entries, patsv);
	SPAGAIN;
    }

    /* chuck it all out, quick or slow */
    if (gimme == G_ARRAY) {
	if (!on_stack) {
	    EXTEND(SP, AvFILLp(entries)+1);
	    Copy(AvARRAY(entries), SP+1, AvFILLp(entries)+1, SV *);
	    SP += AvFILLp(entries)+1;
	}
	/* No G_DISCARD here!  It will free the stack items. */
	hv_delete(MY_CXT.x_GLOB_ENTRIES, cxixpv, cxixlen, 0);
    }
    else {
	if (AvFILLp(entries) + 1) {
	    mPUSHs(av_shift(entries));
	}
	else {
	    /* return undef for EOL */
	    hv_delete(MY_CXT.x_GLOB_ENTRIES, cxixpv, cxixlen, G_DISCARD);
	    PUSHs(&PL_sv_undef);
	}
    }
    PUTBACK;
}

/* returns true if the items are on the stack already, but only in
   list context */
static bool
csh_glob(pTHX_ AV *entries, SV *patsv)
{
	dSP;
	const char *pat;
	AV *patav = NULL;
	const char *patend;
	const char *s = NULL;
	const char *piece = NULL;
	SV *word = NULL;
	int const flags =
	    (int)SvIV(get_sv("File::Glob::DEFAULT_FLAGS", GV_ADD));
	bool is_utf8;
	STRLEN len;
	U32 const gimme = GIMME_V;

	/* glob without args defaults to $_ */
	SvGETMAGIC(patsv);
	if (
	    !SvOK(patsv)
	 && (patsv = DEFSV, SvGETMAGIC(patsv), !SvOK(patsv))
	)
	     pat = "", len = 0, is_utf8 = 0;
	else pat = SvPV_nomg(patsv,len), is_utf8 = !!SvUTF8(patsv);
	patend = pat + len;

	/* extract patterns */
	s = pat-1;
	while (++s < patend) {
	    switch (*s) {
	    case '\'':
	    case '"' :
	      {
		bool found = FALSE;
		const char quote = *s;
		if (!word) {
		    word = newSVpvs("");
		    if (is_utf8) SvUTF8_on(word);
		}
		if (piece) sv_catpvn(word, piece, s-piece);
		piece = s+1;
		while (++s < patend)
		    if (*s == '\\') {
			s++;
			/* If the backslash is here to escape a quote,
			   obliterate it. */
			if (s < patend && *s == quote)
			    sv_catpvn(word, piece, s-piece-1), piece = s;
		    }
		    else if (*s == quote) {
			sv_catpvn(word, piece, s-piece);
			piece = NULL;
			found = TRUE;
			break;
		    }
		if (!found) { /* unmatched quote */
		    /* Give up on tokenisation and treat the whole string
		       as a single token, but with whitespace stripped. */
		    piece = pat;
		    while (isSPACE(*pat)) pat++;
		    while (isSPACE(*(patend-1))) patend--;
		    /* bsd_glob expects a trailing null, but we cannot mod-
		       ify the original */
		    if (patend < SvEND(patsv)) {
			if (word) sv_setpvn(word, pat, patend-pat);
			else
			    word = newSVpvn_flags(
				pat, patend-pat, SVf_UTF8*is_utf8
			    );
			piece = NULL;
		    }
		    else {
			if (word) SvREFCNT_dec(word), word=NULL;
			piece = pat;
			s = patend;
		    }
		    goto end_of_parsing;
		}
		break;
	      }
	    case '\\':
		if (!piece) piece = s;
		s++;
		/* If the backslash is here to escape a quote,
		   obliterate it. */
		if (s < patend && (*s == '"' || *s == '\'')) {
		    if (!word) {
			word = newSVpvn(piece,s-piece-1);
			if (is_utf8) SvUTF8_on(word);
		    }
		    else sv_catpvn(word, piece, s-piece-1);
		    piece = s;
		}
		break;
	    default:
		if (isSPACE(*s)) {
		    if (piece) {
			if (!word) {
			    word = newSVpvn(piece,s-piece);
			    if (is_utf8) SvUTF8_on(word);
			}
			else sv_catpvn(word, piece, s-piece);
		    }
		    if (!word) break;
		    if (!patav) patav = (AV *)sv_2mortal((SV *)newAV());
		    av_push(patav, word);
		    word = NULL;
		    piece = NULL;
		}
		else if (!piece) piece = s;
		break;
	    }
	}
      end_of_parsing:

	assert(SvTYPE(entries) != SVt_PVAV);
	sv_upgrade((SV *)entries, SVt_PVAV);
	
	if (patav) {
	    I32 items = AvFILLp(patav) + 1;
	    SV **svp = AvARRAY(patav);
	    while (items--) {
		PUSHMARK(SP);
		PUTBACK;
		doglob(aTHX_ SvPVXx(*svp++), flags);
		SPAGAIN;
		{
		    dMARK;
		    dORIGMARK;
		    while (++MARK <= SP)
			av_push(entries, SvREFCNT_inc_simple_NN(*MARK));
		    SP = ORIGMARK;
		}
	    }
	}
	/* piece is set at this point if there is no trailing whitespace.
	   It is the beginning of the last token or quote-delimited
	   piece thereof.  word is set at this point if the last token has
	   multiple quoted pieces. */
	if (piece || word) {
	    if (word) {
		if (piece) sv_catpvn(word, piece, s-piece);
		piece = SvPVX(word);
	    }
	    PUSHMARK(SP);
	    PUTBACK;
	    doglob(aTHX_ piece, flags);
	    if (word) SvREFCNT_dec(word);
	    SPAGAIN;
	    {
		dMARK;
		dORIGMARK;
		/* short-circuit here for a fairly common case */
		if (!patav && gimme == G_ARRAY) { PUTBACK; return TRUE; }
		while (++MARK <= SP)
		    av_push(entries, SvREFCNT_inc_simple_NN(*MARK));

		SP = ORIGMARK;
	    }
	}
	PUTBACK;
	return FALSE;
}

static void
csh_glob_iter(pTHX)
{
    iterate(aTHX_ csh_glob);
}

/* wrapper around doglob that can be passed to the iterator */
static bool
doglob_iter_wrapper(pTHX_ AV *entries, SV *patsv)
{
    dSP;
    const char *pattern;
    int const flags =
	    (int)SvIV(get_sv("File::Glob::DEFAULT_FLAGS", GV_ADD));

    SvGETMAGIC(patsv);
    if (
	    !SvOK(patsv)
	 && (patsv = DEFSV, SvGETMAGIC(patsv), !SvOK(patsv))
    )
	 pattern = "";
    else pattern = SvPV_nomg_nolen(patsv);

    PUSHMARK(SP);
    PUTBACK;
    doglob(aTHX_ pattern, flags);
    SPAGAIN;
    {
	dMARK;
	dORIGMARK;
	if (GIMME_V == G_ARRAY) { PUTBACK; return TRUE; }
	sv_upgrade((SV *)entries, SVt_PVAV);
	while (++MARK <= SP)
	    av_push(entries, SvREFCNT_inc_simple_NN(*MARK));
	SP = ORIGMARK;
    }
    return FALSE;
}

static Perl_ophook_t old_ophook;

static void
glob_ophook(pTHX_ OP *o)
{
    dMY_CXT;
    if (MY_CXT.x_GLOB_ENTRIES
     && (o->op_type == OP_GLOB || o->op_type == OP_ENTERSUB))
	hv_delete(MY_CXT.x_GLOB_ENTRIES, (char *)&o, sizeof(OP *),
		  G_DISCARD);
    if (old_ophook) old_ophook(aTHX_ o);
}

MODULE = File::Glob		PACKAGE = File::Glob

int
GLOB_ERROR()
    PREINIT:
	dMY_CXT;
    CODE:
	RETVAL = GLOB_ERROR;
    OUTPUT:
	RETVAL

void
bsd_glob(pattern,...)
    char *pattern
PREINIT:
    int flags = 0;
PPCODE:
    {
	/* allow for optional flags argument */
	if (items > 1) {
	    flags = (int) SvIV(ST(1));
	    /* remove unsupported flags */
	    flags &= ~(GLOB_APPEND | GLOB_DOOFFS | GLOB_ALTDIRFUNC | GLOB_MAGCHAR);
	} else {
	    flags = (int) SvIV(get_sv("File::Glob::DEFAULT_FLAGS", GV_ADD));
	}
	
	PUTBACK;
	doglob(aTHX_ pattern, flags);
	SPAGAIN;
    }

PROTOTYPES: DISABLE
void
csh_glob(...)
PPCODE:
    /* For backward-compatibility with the original Perl function, we sim-
     * ply take the first argument, regardless of how many there are.
     */
    if (items) SP ++;
    else {
	XPUSHs(&PL_sv_undef);
    }
    PUTBACK;
    csh_glob_iter(aTHX);
    SPAGAIN;

void
bsd_glob_override(...)
PPCODE:
    if (items) SP ++;
    else {
	XPUSHs(&PL_sv_undef);
    }
    PUTBACK;
    iterate(aTHX_ doglob_iter_wrapper);
    SPAGAIN;

BOOT:
{
#ifndef PERL_EXTERNAL_GLOB
    /* Don't do this at home! The globhook interface is highly volatile. */
    PL_globhook = csh_glob_iter;
#endif
}

BOOT:
{
    MY_CXT_INIT;
    {
	dMY_CXT;
	MY_CXT.x_GLOB_ENTRIES = NULL;
    }  
    OP_REFCNT_LOCK;
    old_ophook = PL_opfreehook;
    PL_opfreehook = glob_ophook;
    OP_REFCNT_UNLOCK;
}

INCLUDE: const-xs.inc
Commit	Line	Data
8e9c4baf NC	1	#define PERL_NO_GET_CONTEXT
8e9c4baf NC	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
c58b680b FC	70	const char * const cxixpv = (char *)&PL_op;
c58b680b FC	71	STRLEN const cxixlen = sizeof(OP *);
88b04955	72	AV *entries;
3ab888cf	73	U32 const gimme = GIMME_V;
1bb8785a	74	SV *patsv = POPs;
88b04955	75	bool on_stack = FALSE;
1bb8785a	76
1bb8785a	77	if (!MY_CXT.x_GLOB_ENTRIES) MY_CXT.x_GLOB_ENTRIES = newHV();
1d6dcc39	78	entries = (AV )(hv_fetch(MY_CXT.x_GLOB_ENTRIES, cxixpv, cxixlen, 1));
1bb8785a FC	79
1bb8785a FC	80	/* if we're just beginning, do it all first */
1d6dcc39	81	if (SvTYPE(entries) != SVt_PVAV) {
88b04955	82	PUTBACK;
1d6dcc39	83	on_stack = globber(aTHX_ entries, patsv);
88b04955 FC	84	SPAGAIN;
	85	}
	86
	87	/* chuck it all out, quick or slow */
88b04955 FC	88	if (gimme == G_ARRAY) {
88b04955 FC	89	if (!on_stack) {
a6636b43	90	EXTEND(SP, AvFILLp(entries)+1);
88b04955 FC	91	Copy(AvARRAY(entries), SP+1, AvFILLp(entries)+1, SV *);
	92	SP += AvFILLp(entries)+1;
	93	}
88b04955 FC	94	/* No G_DISCARD here! It will free the stack items. */
	95	hv_delete(MY_CXT.x_GLOB_ENTRIES, cxixpv, cxixlen, 0);
	96	}
	97	else {
	98	if (AvFILLp(entries) + 1) {
88b04955 FC	99	mPUSHs(av_shift(entries));
	100	}
	101	else {
	102	/* return undef for EOL */
88b04955 FC	103	hv_delete(MY_CXT.x_GLOB_ENTRIES, cxixpv, cxixlen, G_DISCARD);
	104	PUSHs(&PL_sv_undef);
	105	}
	106	}
	107	PUTBACK;
	108	}
	109
7a26772a FC	110	/* returns true if the items are on the stack already, but only in
7a26772a FC	111	list context */
88b04955	112	static bool
1d6dcc39	113	csh_glob(pTHX_ AV entries, SV patsv)
88b04955 FC	114	{
88b04955 FC	115	dSP;
1bb8785a FC	116	const char *pat;
	117	AV *patav = NULL;
	118	const char *patend;
88b04955	119	const char *s = NULL;
1bb8785a FC	120	const char *piece = NULL;
	121	SV *word = NULL;
	122	int const flags =
	123	(int)SvIV(get_sv("File::Glob::DEFAULT_FLAGS", GV_ADD));
	124	bool is_utf8;
88b04955 FC	125	STRLEN len;
88b04955 FC	126	U32 const gimme = GIMME_V;
1bb8785a FC	127
	128	/* glob without args defaults to $_ */
	129	SvGETMAGIC(patsv);
	130	if (
	131	!SvOK(patsv)
	132	&& (patsv = DEFSV, SvGETMAGIC(patsv), !SvOK(patsv))
	133	)
	134	pat = "", len = 0, is_utf8 = 0;
	135	else pat = SvPV_nomg(patsv,len), is_utf8 = !!SvUTF8(patsv);
	136	patend = pat + len;
	137
	138	/* extract patterns */
1bb8785a FC	139	s = pat-1;
	140	while (++s < patend) {
	141	switch (*s) {
	142	case '\'':
	143	case '"' :
	144	{
	145	bool found = FALSE;
e1621fc9	146	const char quote = *s;
1bb8785a FC	147	if (!word) {
	148	word = newSVpvs("");
	149	if (is_utf8) SvUTF8_on(word);
	150	}
	151	if (piece) sv_catpvn(word, piece, s-piece);
	152	piece = s+1;
f89f9e93	153	while (++s < patend)
e1621fc9 FC	154	if (*s == '\\') {
	155	s++;
	156	/* If the backslash is here to escape a quote,
	157	obliterate it. */
	158	if (s < patend && *s == quote)
	159	sv_catpvn(word, piece, s-piece-1), piece = s;
	160	}
	161	else if (*s == quote) {
1bb8785a FC	162	sv_catpvn(word, piece, s-piece);
	163	piece = NULL;
	164	found = TRUE;
	165	break;
	166	}
	167	if (!found) { /* unmatched quote */
	168	/* Give up on tokenisation and treat the whole string
	169	as a single token, but with whitespace stripped. */
	170	piece = pat;
	171	while (isSPACE(*pat)) pat++;
	172	while (isSPACE(*(patend-1))) patend--;
	173	/* bsd_glob expects a trailing null, but we cannot mod-
	174	ify the original */
	175	if (patend < SvEND(patsv)) {
	176	if (word) sv_setpvn(word, pat, patend-pat);
	177	else
	178	word = newSVpvn_flags(
	179	pat, patend-pat, SVf_UTF8*is_utf8
	180	);
	181	piece = NULL;
	182	}
	183	else {
	184	if (word) SvREFCNT_dec(word), word=NULL;
	185	piece = pat;
	186	s = patend;
	187	}
	188	goto end_of_parsing;
	189	}
	190	break;
	191	}
e1621fc9 FC	192	case '\\':
	193	if (!piece) piece = s;
	194	s++;
	195	/* If the backslash is here to escape a quote,
	196	obliterate it. */
	197	if (s < patend && (s == '"' \|\| s == '\'')) {
	198	if (!word) {
	199	word = newSVpvn(piece,s-piece-1);
	200	if (is_utf8) SvUTF8_on(word);
	201	}
	202	else sv_catpvn(word, piece, s-piece-1);
	203	piece = s;
	204	}
	205	break;
1bb8785a FC	206	default:
	207	if (isSPACE(*s)) {
	208	if (piece) {
	209	if (!word) {
	210	word = newSVpvn(piece,s-piece);
	211	if (is_utf8) SvUTF8_on(word);
	212	}
	213	else sv_catpvn(word, piece, s-piece);
	214	}
	215	if (!word) break;
	216	if (!patav) patav = (AV )sv_2mortal((SV )newAV());
	217	av_push(patav, word);
	218	word = NULL;
	219	piece = NULL;
	220	}
	221	else if (!piece) piece = s;
	222	break;
	223	}
	224	}
	225	end_of_parsing:
	226
1d6dcc39	227	assert(SvTYPE(entries) != SVt_PVAV);
1bb8785a FC	228	sv_upgrade((SV *)entries, SVt_PVAV);
	229
	230	if (patav) {
	231	I32 items = AvFILLp(patav) + 1;
	232	SV **svp = AvARRAY(patav);
	233	while (items--) {
	234	PUSHMARK(SP);
	235	PUTBACK;
	236	doglob(aTHX_ SvPVXx(*svp++), flags);
	237	SPAGAIN;
	238	{
	239	dMARK;
	240	dORIGMARK;
	241	while (++MARK <= SP)
	242	av_push(entries, SvREFCNT_inc_simple_NN(*MARK));
	243	SP = ORIGMARK;
	244	}
	245	}
	246	}
	247	/* piece is set at this point if there is no trailing whitespace.
	248	It is the beginning of the last token or quote-delimited
	249	piece thereof. word is set at this point if the last token has
	250	multiple quoted pieces. */
	251	if (piece \|\| word) {
	252	if (word) {
	253	if (piece) sv_catpvn(word, piece, s-piece);
	254	piece = SvPVX(word);
	255	}
	256	PUSHMARK(SP);
	257	PUTBACK;
	258	doglob(aTHX_ piece, flags);
	259	if (word) SvREFCNT_dec(word);
	260	SPAGAIN;
	261	{
	262	dMARK;
	263	dORIGMARK;
1bb8785a	264	/* short-circuit here for a fairly common case */
88b04955	265	if (!patav && gimme == G_ARRAY) { PUTBACK; return TRUE; }
c0d74586 FC	266	while (++MARK <= SP)
c0d74586 FC	267	av_push(entries, SvREFCNT_inc_simple_NN(*MARK));
1bb8785a FC	268
	269	SP = ORIGMARK;
	270	}
	271	}
88b04955 FC	272	PUTBACK;
	273	return FALSE;
	274	}
1bb8785a	275
88b04955 FC	276	static void
	277	csh_glob_iter(pTHX)
	278	{
	279	iterate(aTHX_ csh_glob);
1bb8785a FC	280	}
1bb8785a FC	281
f4cbf990 FC	282	/* wrapper around doglob that can be passed to the iterator */
f4cbf990 FC	283	static bool
1d6dcc39	284	doglob_iter_wrapper(pTHX_ AV entries, SV patsv)
f4cbf990 FC	285	{
	286	dSP;
	287	const char *pattern;
	288	int const flags =
	289	(int)SvIV(get_sv("File::Glob::DEFAULT_FLAGS", GV_ADD));
f4cbf990 FC	290
	291	SvGETMAGIC(patsv);
	292	if (
	293	!SvOK(patsv)
	294	&& (patsv = DEFSV, SvGETMAGIC(patsv), !SvOK(patsv))
	295	)
	296	pattern = "";
	297	else pattern = SvPV_nomg_nolen(patsv);
	298
	299	PUSHMARK(SP);
	300	PUTBACK;
	301	doglob(aTHX_ pattern, flags);
	302	SPAGAIN;
	303	{
	304	dMARK;
	305	dORIGMARK;
	306	if (GIMME_V == G_ARRAY) { PUTBACK; return TRUE; }
f4cbf990 FC	307	sv_upgrade((SV *)entries, SVt_PVAV);
	308	while (++MARK <= SP)
	309	av_push(entries, SvREFCNT_inc_simple_NN(*MARK));
	310	SP = ORIGMARK;
	311	}
	312	return FALSE;
	313	}
	314
11ddfebc FC	315	static Perl_ophook_t old_ophook;
	316
	317	static void
	318	glob_ophook(pTHX_ OP *o)
	319	{
	320	dMY_CXT;
	321	if (MY_CXT.x_GLOB_ENTRIES
	322	&& (o->op_type == OP_GLOB \|\| o->op_type == OP_ENTERSUB))
	323	hv_delete(MY_CXT.x_GLOB_ENTRIES, (char )&o, sizeof(OP ),
	324	G_DISCARD);
	325	if (old_ophook) old_ophook(aTHX_ o);
	326	}
	327
72b16652 GS	328	MODULE = File::Glob PACKAGE = File::Glob
72b16652 GS	329
b84cd0b1 NC	330	int
	331	GLOB_ERROR()
	332	PREINIT:
	333	dMY_CXT;
	334	CODE:
	335	RETVAL = GLOB_ERROR;
	336	OUTPUT:
	337	RETVAL
	338
72b16652	339	void
960ddb65	340	bsd_glob(pattern,...)
72b16652	341	char *pattern
72b16652	342	PREINIT:
72b16652	343	int flags = 0;
72b16652 GS	344	PPCODE:
	345	{
	346	/* allow for optional flags argument */
	347	if (items > 1) {
	348	flags = (int) SvIV(ST(1));
3c97495f CB	349	/* remove unsupported flags */
3c97495f CB	350	flags &= ~(GLOB_APPEND \| GLOB_DOOFFS \| GLOB_ALTDIRFUNC \| GLOB_MAGCHAR);
960ddb65	351	} else {
28cd8e1d	352	flags = (int) SvIV(get_sv("File::Glob::DEFAULT_FLAGS", GV_ADD));
72b16652	353	}
1bb8785a FC	354
	355	PUTBACK;
	356	doglob(aTHX_ pattern, flags);
	357	SPAGAIN;
	358	}
72b16652	359
1bb8785a FC	360	PROTOTYPES: DISABLE
	361	void
	362	csh_glob(...)
	363	PPCODE:
	364	/* For backward-compatibility with the original Perl function, we sim-
f01818e2	365	* ply take the first argument, regardless of how many there are.
1bb8785a	366	*/
f01818e2	367	if (items) SP ++;
1bb8785a	368	else {
1bb8785a	369	XPUSHs(&PL_sv_undef);
72b16652	370	}
1bb8785a	371	PUTBACK;
88b04955	372	csh_glob_iter(aTHX);
1bb8785a	373	SPAGAIN;
72b16652	374
f4cbf990 FC	375	void
	376	bsd_glob_override(...)
	377	PPCODE:
f01818e2	378	if (items) SP ++;
f4cbf990	379	else {
f4cbf990	380	XPUSHs(&PL_sv_undef);
f4cbf990 FC	381	}
	382	PUTBACK;
	383	iterate(aTHX_ doglob_iter_wrapper);
	384	SPAGAIN;
	385
28cd8e1d NC	386	BOOT:
28cd8e1d NC	387	{
d67594ff	388	#ifndef PERL_EXTERNAL_GLOB
e1fa07e3	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:
bcd258b8 NC	395	{
28cd8e1d	396	MY_CXT_INIT;
1bb8785a FC	397	{
1bb8785a FC	398	dMY_CXT;
6a606603	399	MY_CXT.x_GLOB_ENTRIES = NULL;
1bb8785a	400	}
11ddfebc FC	401	OP_REFCNT_LOCK;
	402	old_ophook = PL_opfreehook;
	403	PL_opfreehook = glob_ophook;
	404	OP_REFCNT_UNLOCK;
28cd8e1d NC	405	}
28cd8e1d NC	406
1cb0fb50	407	INCLUDE: const-xs.inc