[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 {
#ifdef USE_ITHREADS
    tTHX interp;
#endif
    int		x_GLOB_ERROR;
    HV *	x_GLOB_ENTRIES;
    Perl_ophook_t	x_GLOB_OLD_OPHOOK;
} 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, const char *pat, STRLEN len, bool is_utf8))
{
    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) {
        const char *pat;
        STRLEN len;
        bool is_utf8;

        /* 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);
            /* the lower-level code expects a null-terminated string */
            if (!SvPOK(patsv) || pat != SvPVX(patsv) || pat[len] != '\0') {
                SV *newpatsv = newSVpvn_flags(pat, len, SVs_TEMP);
                pat = SvPV_nomg(newpatsv,len);
            }
        }

        if (!IS_SAFE_SYSCALL(pat, len, "pattern", "glob")) {
            if (gimme != G_ARRAY)
                PUSHs(&PL_sv_undef);
            PUTBACK;
            return;
        }

	PUTBACK;
	on_stack = globber(aTHX_ entries, pat, len, is_utf8);
	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. */
	(void)hv_delete(MY_CXT.x_GLOB_ENTRIES, cxixpv, cxixlen, 0);
    }
    else {
	if (AvFILLp(entries) + 1) {
	    mPUSHs(av_shift(entries));
	}
	else {
	    /* return undef for EOL */
	    (void)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, const char *pat, STRLEN len, bool is_utf8)
{
	dSP;
	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));
	U32 const gimme = GIMME_V;

	patend = pat + len;

	assert(SvTYPE(entries) != SVt_PVAV);
	sv_upgrade((SV *)entries, SVt_PVAV);

	/* 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 < pat + len) {
			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:

	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, const char *pattern, STRLEN len, bool is_utf8)
{
    dSP;
    int const flags =
	    (int)SvIV(get_sv("File::Glob::DEFAULT_FLAGS", GV_ADD));

    PERL_UNUSED_VAR(len); /* we use \0 termination instead */
    /* XXX we currently just use the underlying bytes of the passed SV.
     * Some day someone needs to make glob utf8 aware */
    PERL_UNUSED_VAR(is_utf8);

    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 void
glob_ophook(pTHX_ OP *o)
{
  if (PL_dirty) return;
  {
    dMY_CXT;
    if (MY_CXT.x_GLOB_ENTRIES
     && (o->op_type == OP_GLOB || o->op_type == OP_ENTERSUB))
	(void)hv_delete(MY_CXT.x_GLOB_ENTRIES, (char *)&o, sizeof(OP *),
		  G_DISCARD);
    if (MY_CXT.x_GLOB_OLD_OPHOOK) MY_CXT.x_GLOB_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_sv,...)
    SV *pattern_sv
PREINIT:
    int flags = 0;
    char *pattern;
    STRLEN len;
PPCODE:
    {
        pattern = SvPV(pattern_sv, len);
        if (!IS_SAFE_SYSCALL(pattern, len, "pattern", "bsd_glob"))
            XSRETURN(0);
	/* 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;

#ifdef USE_ITHREADS

void
CLONE(...)
INIT:
    HV *glob_entries_clone = NULL;
CODE:
    PERL_UNUSED_ARG(items);
    {
        dMY_CXT;
        if ( MY_CXT.x_GLOB_ENTRIES ) {
            CLONE_PARAMS param;
            param.stashes    = NULL;
            param.flags      = 0;
            param.proto_perl = MY_CXT.interp;
            
            glob_entries_clone = MUTABLE_HV(sv_dup_inc((SV*)MY_CXT.x_GLOB_ENTRIES, &param));
        }
    }
    {
        MY_CXT_CLONE;
        MY_CXT.x_GLOB_ENTRIES = glob_entries_clone;
        MY_CXT.interp = aTHX;
    }

#endif

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;
	MY_CXT.x_GLOB_OLD_OPHOOK = PL_opfreehook;
#ifdef USE_ITHREADS
        MY_CXT.interp = aTHX;
#endif
	PL_opfreehook = glob_ophook;
    }  
}

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