/*
 * This file was generated automatically by ExtUtils::ParseXS version 3.63 from the
 * contents of PerlIO-Util.xs. Do not edit this file, edit PerlIO-Util.xs instead.
 *
 *    ANY CHANGES MADE HERE WILL BE LOST!
 *
 */

#line 1 "PerlIO-Util.xs"
/*
	PerlIO-Util/Util.xs
*/

#include "perlioutil.h"

#ifndef gv_stashpvs
#define gv_stashpvs(s, c) gv_stashpvn(s "", sizeof(s)-1, c)
#endif

PerlIO*
PerlIOUtil_openn(pTHX_ PerlIO_funcs* const force_tab, PerlIO_list_t* const layers, IV const n,
		const char* const mode, int const fd, int const imode, int const perm,
		PerlIO* f, int const narg, SV** const args){
	PerlIO_funcs* tab = NULL;
	IV i = n;

	while(--i >= 0){ /* find a layer with Open() */
		tab = LayerFetch(layers, i);
		if(tab && tab->Open){
			break;
		}
	}

	if(force_tab) tab = force_tab;

	if(tab && tab->Open){
		f = tab->Open(aTHX_ tab, layers, i,  mode,
				fd, imode, perm, f, narg, args);

		/* apply 'upper' layers
		   e.g. [ :unix :perlio :utf8 :creat ]
		                        ~~~~~        
		*/

		if(f && ++i < n){
			if(PerlIO_apply_layera(aTHX_ f, mode, layers, i, n) != 0){
				PerlIO_close(f);
				f = NULL;
			}
		}

	}
	else{
		SETERRNO(EINVAL, LIB_INVARG);
	}

	return f;
}

#define PutFlag(c) do{\
		if(PerlIOBase(f)->flags & (PERLIO_F_##c)){\
			sv_catpvs(sv, " " #c);\
		}\
	}while(0)

SV*
PerlIOUtil_inspect(pTHX_ PerlIO* f, int const level){
	int i;
	SV* const sv = newSVpvs(" ");

	for(i = 0; i < level; i++) sv_catpvs(sv, "  ");

	sv_catpvf(sv, "PerlIO 0x%p\n", f);

	if(!PerlIOValid(f)){
		for(i = 0; i <= level; i++) sv_catpvs(sv, "  ");

		sv_catpvs(sv, "(Invalid filehandle)\n");
	}

	while(PerlIOValid(f)){
		for(i = 0; i <= level; i++) sv_catpv(sv, "  ");

		sv_catpvf(sv, "0x%p:%s(%d)",
			*f, PerlIOBase(f)->tab->name,
			(int)PerlIO_fileno(f));
		PutFlag(EOF);
		PutFlag(CANWRITE);
		PutFlag(CANREAD);
		PutFlag(ERROR);
		PutFlag(TRUNCATE);
		PutFlag(APPEND);
		PutFlag(CRLF);
		PutFlag(UTF8);
		PutFlag(UNBUF);

		PutFlag(WRBUF);
		if(IOLflag(f, PERLIO_F_WRBUF)){
			sv_catpvf(sv, "(%" IVdf "/%" IVdf ")",
				(IV)PerlIO_get_cnt(f),
				(IV)PerlIO_get_bufsiz(f));
		}
		PutFlag(RDBUF);
		if(IOLflag(f, PERLIO_F_RDBUF)){
			sv_catpvf(sv, "(%" IVdf "/%" IVdf ")",
				(IV)PerlIO_get_cnt(f),
				(IV)PerlIO_get_bufsiz(f));
		}

		PutFlag(LINEBUF);
		PutFlag(TEMP);
		PutFlag(OPEN);
		PutFlag(FASTGETS);
		PutFlag(TTY);
		PutFlag(NOTREG);
		sv_catpvs(sv, "\n");

		if( strEQ(PerlIOBase(f)->tab->name, "tee") ){
			PerlIO* const teeout = PerlIOTee_teeout(aTHX_ f);
			SV* const t = PerlIOUtil_inspect(aTHX_ teeout, level+1);

			sv_catsv(sv, t);
			SvREFCNT_dec(t);
		}

		f = PerlIONext(f);
	}

	return sv;
}

void
PerlIOUtil_warnif(pTHX_ U32 const category, const char* const fmt, ...){
	if(ckWARN(category)){
		va_list args;
		va_start(args, fmt);
		vwarner(category, fmt, &args);
		va_end(args);
	}
}

#line 143 "PerlIO-Util.c"
#ifndef PERL_UNUSED_VAR
#  define PERL_UNUSED_VAR(var) if (0) var = var
#endif

#ifndef dVAR
#  define dVAR		dNOOP
#endif


/* This stuff is not part of the API! You have been warned. */
#ifndef PERL_VERSION_DECIMAL
#  define PERL_VERSION_DECIMAL(r,v,s) (r*1000000 + v*1000 + s)
#endif
#ifndef PERL_DECIMAL_VERSION
#  define PERL_DECIMAL_VERSION \
	  PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION)
#endif
#ifndef PERL_VERSION_GE
#  define PERL_VERSION_GE(r,v,s) \
	  (PERL_DECIMAL_VERSION >= PERL_VERSION_DECIMAL(r,v,s))
#endif
#ifndef PERL_VERSION_LE
#  define PERL_VERSION_LE(r,v,s) \
	  (PERL_DECIMAL_VERSION <= PERL_VERSION_DECIMAL(r,v,s))
#endif

/* XS_INTERNAL is the explicit static-linkage variant of the default
 * XS macro.
 *
 * XS_EXTERNAL is the same as XS_INTERNAL except it does not include
 * "static", ie. it exports XSUB symbols. You probably don't want that
 * for anything but the BOOT XSUB.
 *
 * See XSUB.h in core!
 */


/* TODO: This might be compatible further back than 5.10.0. */
#if PERL_VERSION_GE(5, 10, 0) && PERL_VERSION_LE(5, 15, 1)
#  undef XS_EXTERNAL
#  undef XS_INTERNAL
#  if defined(__CYGWIN__) && defined(USE_DYNAMIC_LOADING)
#    define XS_EXTERNAL(name) __declspec(dllexport) XSPROTO(name)
#    define XS_INTERNAL(name) static XSPROTO(name)
#  endif
#  if defined(__SYMBIAN32__)
#    define XS_EXTERNAL(name) EXPORT_C XSPROTO(name)
#    define XS_INTERNAL(name) EXPORT_C static XSPROTO(name)
#  endif
#  ifndef XS_EXTERNAL
#    if defined(HASATTRIBUTE_UNUSED) && !defined(__cplusplus)
#      define XS_EXTERNAL(name) void name(pTHX_ CV* cv __attribute__unused__)
#      define XS_INTERNAL(name) static void name(pTHX_ CV* cv __attribute__unused__)
#    else
#      ifdef __cplusplus
#        define XS_EXTERNAL(name) extern "C" XSPROTO(name)
#        define XS_INTERNAL(name) static XSPROTO(name)
#      else
#        define XS_EXTERNAL(name) XSPROTO(name)
#        define XS_INTERNAL(name) static XSPROTO(name)
#      endif
#    endif
#  endif
#endif

/* perl >= 5.10.0 && perl <= 5.15.1 */


/* The XS_EXTERNAL macro is used for functions that must not be static
 * like the boot XSUB of a module. If perl didn't have an XS_EXTERNAL
 * macro defined, the best we can do is assume XS is the same.
 * Dito for XS_INTERNAL.
 */
#ifndef XS_EXTERNAL
#  define XS_EXTERNAL(name) XS(name)
#endif
#ifndef XS_INTERNAL
#  define XS_INTERNAL(name) XS(name)
#endif

/* Now, finally, after all this mess, we want an ExtUtils::ParseXS
 * internal macro that we're free to redefine for varying linkage due
 * to the EXPORT_XSUB_SYMBOLS XS keyword. This is internal, use
 * XS_EXTERNAL(name) or XS_INTERNAL(name) in your code if you need to!
 */

#undef XS_EUPXS
#if defined(PERL_EUPXS_ALWAYS_EXPORT)
#  define XS_EUPXS(name) XS_EXTERNAL(name)
#else
   /* default to internal */
#  define XS_EUPXS(name) XS_INTERNAL(name)
#endif

#ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE
#define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params)

/* prototype to pass -Wmissing-prototypes */
static void
S_croak_xs_usage(const CV *const cv, const char *const params);

static void
S_croak_xs_usage(const CV *const cv, const char *const params)
{
    const GV *const gv = CvGV(cv);

    PERL_ARGS_ASSERT_CROAK_XS_USAGE;

    if (gv) {
        const char *const gvname = GvNAME(gv);
        const HV *const stash = GvSTASH(gv);
        const char *const hvname = stash ? HvNAME(stash) : NULL;

        if (hvname)
	    Perl_croak_nocontext("Usage: %s::%s(%s)", hvname, gvname, params);
        else
	    Perl_croak_nocontext("Usage: %s(%s)", gvname, params);
    } else {
        /* Pants. I don't think that it should be possible to get here. */
	Perl_croak_nocontext("Usage: CODE(0x%" UVxf ")(%s)", PTR2UV(cv), params);
    }
}
#undef  PERL_ARGS_ASSERT_CROAK_XS_USAGE

#define croak_xs_usage        S_croak_xs_usage

#endif

/* NOTE: the prototype of newXSproto() is different in versions of perls,
 * so we define a portable version of newXSproto()
 */
#ifdef newXS_flags
#define newXSproto_portable(name, c_impl, file, proto) newXS_flags(name, c_impl, file, proto, 0)
#else
#define newXSproto_portable(name, c_impl, file, proto) (PL_Sv=(SV*)newXS(name, c_impl, file), sv_setpv(PL_Sv, proto), (CV*)PL_Sv)
#endif /* !defined(newXS_flags) */

#if PERL_VERSION_LE(5, 21, 5)
#  define newXS_deffile(a,b) Perl_newXS(aTHX_ a,b,file)
#else
#  define newXS_deffile(a,b) Perl_newXS_deffile(aTHX_ a,b)
#endif

/* simple backcompat versions of the TARGx() macros with no optimisation */
#ifndef TARGi
#  define TARGi(iv, do_taint) sv_setiv_mg(TARG, iv)
#  define TARGu(uv, do_taint) sv_setuv_mg(TARG, uv)
#  define TARGn(nv, do_taint) sv_setnv_mg(TARG, nv)
#endif

#line 294 "PerlIO-Util.c"

XS_EUPXS(XS_PerlIO__Util_known_layers); /* prototype to pass -Wmissing-prototypes */
XS_EUPXS(XS_PerlIO__Util_known_layers)
{
    dVAR; dXSARGS;
    PERL_UNUSED_VAR(cv); /* -W */
    PERL_UNUSED_VAR(items); /* -W */
    PERL_UNUSED_VAR(ax); /* -Wall */
    SP -= items;
    {
#line 148 "PerlIO-Util.xs"
	const PerlIO_list_t* const layers = PL_known_layers;
	int i;
#line 308 "PerlIO-Util.c"
#line 151 "PerlIO-Util.xs"
	EXTEND(SP, layers->cur);
	for(i = 0; i < layers->cur; i++){
		SV* const name = newSVpv( LayerFetch(layers, i)->name, 0);
		PUSHs( sv_2mortal(name) );
	}
	XSRETURN(layers->cur);
#line 316 "PerlIO-Util.c"
	PUTBACK;
	return;
    }
}


XS_EUPXS(XS_PerlIO__Util__gensym_ref); /* prototype to pass -Wmissing-prototypes */
XS_EUPXS(XS_PerlIO__Util__gensym_ref)
{
    dVAR; dXSARGS;
    if (items != 2)
       croak_xs_usage(cv,  "pkg, name");
    {
#line 161 "PerlIO-Util.xs"
	STRLEN len;
	const char* pv;
	GV* const gv = (GV*)newSV(0);
#line 334 "PerlIO-Util.c"
	SV *	RETVAL;
	SV*	pkg = ST(0)
;
	SV*	name = ST(1)
;
#line 165 "PerlIO-Util.xs"
	pv = SvPV_const(name, len);
	/* see also pp_rv2gv() in pp.c */
	gv_init(gv, gv_stashsv(pkg, TRUE), pv, len, GV_ADD);
	RETVAL = newRV_noinc((SV*)gv);

	sv_bless(RETVAL, gv_stashpvs("IO::Handle", TRUE));
#line 347 "PerlIO-Util.c"
	RETVAL = sv_2mortal(RETVAL);
	ST(0) = RETVAL;
    }
    XSRETURN(1);
}

#define undef (&PL_sv_undef)

XS_EUPXS(XS_IO__Handle_push_layer); /* prototype to pass -Wmissing-prototypes */
XS_EUPXS(XS_IO__Handle_push_layer)
{
    dVAR; dXSARGS;
    if (items < 2 || items > 3)
       croak_xs_usage(cv,  "filehandle, layer, arg = undef");
    PERL_UNUSED_VAR(ax); /* -Wall */
    SP -= items;
    {
	PerlIO*	filehandle = IoIFP(sv_2io(ST(0)))
;
	SV*	layer = ST(1)
;
	SV*	arg;
#line 186 "PerlIO-Util.xs"
	PerlIO_funcs* tab;
	const char* laypv;
	STRLEN laylen;
#line 374 "PerlIO-Util.c"

	if (items < 3)
	    arg = undef;
	else {
	    arg = ST(2)
;
	}
#line 190 "PerlIO-Util.xs"
	laypv = SvPV_const(layer, laylen);
	if(laypv[0] == ':'){ /* ignore a layer prefix */
		laypv++;
		laylen--;
	}
	tab = PerlIO_find_layer(aTHX_ laypv, laylen, TRUE);
	if(tab){
		if(!PerlIO_push(aTHX_ filehandle, tab, NULL, arg)){
			Perl_croak(aTHX_ "push_layer() failed: %s",
				PerlIOValid(filehandle)
					? Strerror(errno)
					: "Invalid filehandle");
		}
	}
	else{
		Perl_croak(aTHX_ "Unknown PerlIO layer \"%.*s\"",
				(int)laylen, laypv);
	}
	XSRETURN(1); /* returns self */
#line 402 "PerlIO-Util.c"
	PUTBACK;
	return;
    }
}


XS_EUPXS(XS_IO__Handle_pop_layer); /* prototype to pass -Wmissing-prototypes */
XS_EUPXS(XS_IO__Handle_pop_layer)
{
    dVAR; dXSARGS;
    if (items != 1)
       croak_xs_usage(cv,  "filehandle");
    PERL_UNUSED_VAR(ax); /* -Wall */
    SP -= items;
    {
	PerlIO*	filehandle = IoIFP(sv_2io(ST(0)))
;
#line 214 "PerlIO-Util.xs"
	const char* popped_layer;
#line 422 "PerlIO-Util.c"
#line 216 "PerlIO-Util.xs"
	if(!PerlIOValid(filehandle)) XSRETURN_EMPTY;
	popped_layer = PerlIOBase(filehandle)->tab->name;

	PerlIO_flush(filehandle);
	PerlIO_pop(aTHX_ filehandle);

	if(GIMME_V != G_VOID){
		XSRETURN_PV(popped_layer);
	}
#line 433 "PerlIO-Util.c"
	PUTBACK;
	return;
    }
}


XS_EUPXS(XS_IO__Handle_inspect); /* prototype to pass -Wmissing-prototypes */
XS_EUPXS(XS_IO__Handle_inspect)
{
    dVAR; dXSARGS;
    if (items != 1)
       croak_xs_usage(cv,  "f");
    {
	PerlIO*	f = IoIFP(sv_2io(ST(0)))
;
	SV *	RETVAL;

	RETVAL = perlio_inspect(f);
	RETVAL = sv_2mortal(RETVAL);
	ST(0) = RETVAL;
    }
    XSRETURN(1);
}

#ifdef __cplusplus
extern "C" {
#endif
XS_EXTERNAL(boot_PerlIO__Util); /* prototype to pass -Wmissing-prototypes */
XS_EXTERNAL(boot_PerlIO__Util)
{
#if PERL_VERSION_LE(5, 21, 5)
    dVAR; dXSARGS;
#else
    dVAR; dXSBOOTARGSXSAPIVERCHK;
#endif
#if PERL_VERSION_LE(5, 8, 999) /* PERL_VERSION_LT is 5.33+ */
    char* file = __FILE__;
#else
    const char* file = __FILE__;
#endif

    PERL_UNUSED_VAR(file);

    PERL_UNUSED_VAR(cv); /* -W */
    PERL_UNUSED_VAR(items); /* -W */
#if PERL_VERSION_LE(5, 21, 5)
    XS_VERSION_BOOTCHECK;
#  ifdef XS_APIVERSION_BOOTCHECK
    XS_APIVERSION_BOOTCHECK;
#  endif
#endif

        newXS_deffile("PerlIO::Util::known_layers", XS_PerlIO__Util_known_layers);
        newXS_deffile("PerlIO::Util::_gensym_ref", XS_PerlIO__Util__gensym_ref);
        newXS_deffile("IO::Handle::push_layer", XS_IO__Handle_push_layer);
        newXS_deffile("IO::Handle::pop_layer", XS_IO__Handle_pop_layer);
        newXS_deffile("IO::Handle::inspect", XS_IO__Handle_inspect);

    /* Initialisation Section */

#line 138 "PerlIO-Util.xs"
	PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_flock));
	PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_creat));
	PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_excl));
	PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_tee));
	PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_dir));
	PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_reverse));

#line 502 "PerlIO-Util.c"

    /* End of Initialisation Section */

#if PERL_VERSION_LE(5, 21, 5)
#  if PERL_VERSION_GE(5, 9, 0)
    if (PL_unitcheckav)
        call_list(PL_scopestack_ix, PL_unitcheckav);
#  endif
    XSRETURN_YES;
#else
    Perl_xs_boot_epilog(aTHX_ ax);
#endif
}

#ifdef __cplusplus
}
#endif
