[gitmo/Class-MOP.git] / xs / Package.xs

#define NEED_newSVpvn_flags
#include "mop.h"

static SV*
mop_deconstruct_variable_name(pTHX_ SV* const variable, svtype* const type, const char** const type_name) {
	SV* name;

	if(SvROK(variable) && SvTYPE(SvRV(variable)) == SVt_PVHV){
		/* e.g. variable = { type => "SCALAR", name => "foo" } */
		HV* const hv = (HV*)SvRV(variable);
		SV** svp;
		STRLEN len;
		const char* pv;

		svp = hv_fetchs(hv, "name", FALSE);
		if(!(svp && SvOK(*svp))){
			croak("You must pass a variable name");
		}
		name = *svp;
		pv   = SvPV_const(name, len);
		if(len < 1){
			croak("You must pass a variable name");
		}

		svp = hv_fetchs(hv, "type", FALSE);
		if(!(svp && SvOK(*svp))) {
			croak("You must pass a variable type");
		}
		pv = SvPV_nolen_const(*svp);
		if(strEQ(pv, "SCALAR")){
			*type = SVt_PV; /* for all the type of scalars */
		}
		else if(strEQ(pv, "ARRAY")){
			*type = SVt_PVAV;
		}
		else if(strEQ(pv, "HASH")){
			*type = SVt_PVHV;
		}
		else if(strEQ(pv, "CODE")){
			*type = SVt_PVCV;
		}
		else if(strEQ(pv, "GLOB")){
			*type = SVt_PVGV;
		}
		else if(strEQ(pv, "IO")){
			*type = SVt_PVIO;
		}
		else{
			croak("I do not recognize that type '%s'", pv);
		}
		*type_name = pv;
	}
	else {
		STRLEN len;
		const char* pv;
		/* e.g. variable = '$foo' */
		if(!SvOK(variable)) {
			croak("You must pass a variable name");
		}
		pv = SvPV_const(variable, len);
		if(len < 2){
			croak("You must pass a variable name including a sigil");
		}

		switch(pv[0]){
		case '$':
			*type      = SVt_PV; /* for all the types of scalars */
			*type_name = "SCALAR";
			break;
		case '@':
			*type      = SVt_PVAV;
			*type_name = "ARRAY";
			break;
		case '%':
			*type      = SVt_PVHV;
			*type_name = "HASH";
			break;
		case '&':
			*type      = SVt_PVCV;
			*type_name = "CODE";
			break;
		case '*':
			*type      = SVt_PVGV;
			*type_name = "GLOB";
			break;
		default:
			croak("I do not recognize that sigil '%c'", pv[0]);
		}

		name = newSVpvn_share(pv+1, len-1, 0U);
		sv_2mortal(name);
	}

	return name;
}

MODULE = Class::MOP::Package   PACKAGE = Class::MOP::Package

PROTOTYPES: DISABLE

void
get_all_package_symbols(self, filter=TYPE_FILTER_NONE)
    SV *self
    type_filter_t filter
    PREINIT:
        HV *stash = NULL;
        HV *symbols = NULL;
        register HE *he;
    PPCODE:
        if ( ! SvROK(self) ) {
            die("Cannot call get_all_package_symbols as a class method");
        }

        if (GIMME_V == G_VOID) {
            XSRETURN_EMPTY;
        }

        PUTBACK;

        if ( (he = hv_fetch_ent((HV *)SvRV(self), KEY_FOR(package), 0, HASH_FOR(package))) ) {
            stash = gv_stashsv(HeVAL(he), 0);
        }


        if (!stash) {
            XSRETURN_UNDEF;
        }

        symbols = mop_get_all_package_symbols(stash, filter);
        PUSHs(sv_2mortal(newRV_noinc((SV *)symbols)));

BOOT:
    INSTALL_SIMPLE_READER_WITH_KEY(Package, name, package);

SV*
add_package_symbol(SV* self, SV* variable, SV* ref = &PL_sv_undef)
PREINIT:
	svtype type;
	const char* type_name;
	SV* var_name;
	SV* package_name;
	SV* fq_name;
CODE:
	var_name = mop_deconstruct_variable_name(aTHX_ variable, &type, &type_name);

	package_name = mop_call0(aTHX_ self, KEY_FOR(name));
	if(!SvOK(package_name)){
		croak("name() did not return a defined value");
	}
	fq_name = newSVpvf("%"SVf"::%"SVf, package_name, var_name);
	sv_2mortal(fq_name);

	if(SvOK(ref)){ /* set */
		GV* gv;
		if(type == SVt_PV){
			if(!SvROK(ref)){
				ref = newRV_noinc(newSVsv(ref));
				sv_2mortal(ref);
			}
		}
		else if(!(SvROK(ref) && SvTYPE(SvRV(ref)) == type)){
			croak("You must pass a reference of %s for the value of %s", type_name, GvNAME(CvGV(cv)));
		}
		gv = gv_fetchsv(fq_name, GV_ADDMULTI, type);

		if(type == SVt_PVCV && GvCV(gv)){
			/* XXX: should introduce an option { redefine => 1 } ? */
			SvREFCNT_dec(GvCV(gv));
			GvCV(gv) = NULL;
		}
		sv_setsv_mg((SV*)gv, ref); /* *glob = $ref */
		RETVAL = ref;
	}
	else { /* init */
		GV* const gv = gv_fetchsv(fq_name, GV_ADDMULTI, type);
		SV* sv;

		switch(type){
		case SVt_PV:
			sv = GvSVn(gv);
			break;
		case SVt_PVAV:
			sv = (SV*)GvAVn(gv);
			break;
		case SVt_PVHV:
			sv = (SV*)GvHVn(gv);
			break;
		case SVt_PVCV:
			sv = (SV*)GvCV(gv);
			break;
		case SVt_PVGV:
			sv = (SV*)gv;
			break;
		case SVt_PVIO:
			sv = (SV*)GvIOn(gv);
			break;
		default:
			croak("NOT REACHED");
			sv = NULL; /* -W */
			break;
		}

		if(sv){
			RETVAL = sv_2mortal(newRV_inc(sv));
		}
		else{
			RETVAL = &PL_sv_undef;
		}
	}
	ST(0) = RETVAL;

SV*
get_package_symbol(SV* self, SV* variable)
ALIAS:
	get_package_symbol = GV_ADDMULTI
	has_package_symbol = 0
PREINIT:
	svtype type;
	const char* type_name;
	SV* var_name;
	SV* package_name;
	SV* fq_name;
	GV* gv;
	SV* sv;
CODE:
	var_name = mop_deconstruct_variable_name(aTHX_ variable, &type, &type_name);

	package_name = mop_call0(aTHX_ self, KEY_FOR(name));
	if(!SvOK(package_name)){
		croak("name() did not return a defined value");
	}
	fq_name = newSVpvf("%"SVf"::%"SVf, package_name, var_name);
	sv_2mortal(fq_name);

	gv = gv_fetchsv(fq_name, ix, type);
	if(!gv){ /* no symbol in has_package_symbol() */
		XSRETURN_NO;
	}

	switch(type){
	case SVt_PV:
		sv = GvSV(gv);
		break;
	case SVt_PVAV:
		sv = (SV*)GvAV(gv);
		break;
	case SVt_PVHV:
		sv = (SV*)GvHV(gv);
		break;
	case SVt_PVCV:
		sv = (SV*)GvCV(gv);
		break;
	case SVt_PVGV:
		sv = (SV*)gv;
		break;
	case SVt_PVIO:
		sv = (SV*)GvIO(gv);
		break;
	default:
		croak("NOT REACHED");
		sv = NULL; /* -W */
		break;
	}

	if(!ix){ /* has_package_symbol */
		RETVAL = boolSV(sv);
	}
	else{
		if(sv){
			RETVAL = newRV_inc(sv);
		}
		else{
			RETVAL = &PL_sv_undef;
		}
	}
OUTPUT:
	RETVAL
Commit	Line	Data
e170f134	1	#define NEED_newSVpvn_flags
d846ade3	2	#include "mop.h"
d846ade3	3
e170f134	4	static SV*
	5	mop_deconstruct_variable_name(pTHX_ SV* const variable, svtype* const type, const char** const type_name) {
	6	SV* name;
	7
	8	if(SvROK(variable) && SvTYPE(SvRV(variable)) == SVt_PVHV){
	9	/* e.g. variable = { type => "SCALAR", name => "foo" } */
	10	HV* const hv = (HV*)SvRV(variable);
	11	SV** svp;
	12	STRLEN len;
	13	const char* pv;
	14
	15	svp = hv_fetchs(hv, "name", FALSE);
	16	if(!(svp && SvOK(*svp))){
	17	croak("You must pass a variable name");
	18	}
	19	name = *svp;
	20	pv = SvPV_const(name, len);
	21	if(len < 1){
	22	croak("You must pass a variable name");
	23	}
	24
	25	svp = hv_fetchs(hv, "type", FALSE);
	26	if(!(svp && SvOK(*svp))) {
	27	croak("You must pass a variable type");
	28	}
	29	pv = SvPV_nolen_const(*svp);
	30	if(strEQ(pv, "SCALAR")){
	31	type = SVt_PV; / for all the type of scalars */
	32	}
	33	else if(strEQ(pv, "ARRAY")){
	34	*type = SVt_PVAV;
	35	}
	36	else if(strEQ(pv, "HASH")){
	37	*type = SVt_PVHV;
	38	}
	39	else if(strEQ(pv, "CODE")){
	40	*type = SVt_PVCV;
	41	}
	42	else if(strEQ(pv, "GLOB")){
	43	*type = SVt_PVGV;
	44	}
	45	else if(strEQ(pv, "IO")){
	46	*type = SVt_PVIO;
	47	}
	48	else{
	49	croak("I do not recognize that type '%s'", pv);
	50	}
	51	*type_name = pv;
	52	}
	53	else {
	54	STRLEN len;
	55	const char* pv;
	56	/* e.g. variable = '$foo' */
	57	if(!SvOK(variable)) {
	58	croak("You must pass a variable name");
	59	}
	60	pv = SvPV_const(variable, len);
	61	if(len < 2){
	62	croak("You must pass a variable name including a sigil");
	63	}
	64
	65	switch(pv[0]){
	66	case '$':
	67	type = SVt_PV; / for all the types of scalars */
68	*type_name = "SCALAR";
69	break;
70	case '@':
71	*type = SVt_PVAV;
72	*type_name = "ARRAY";
73	break;
74	case '%':
75	*type = SVt_PVHV;
76	*type_name = "HASH";
77	break;
78	case '&':
79	*type = SVt_PVCV;
80	*type_name = "CODE";
81	break;
82	case '*':
83	*type = SVt_PVGV;
84	*type_name = "GLOB";
85	break;
86	default:
87	croak("I do not recognize that sigil '%c'", pv[0]);
88	}
89
90	name = newSVpvn_share(pv+1, len-1, 0U);
91	sv_2mortal(name);
92	}
93
94	return name;
95	}
96
d846ade3	97	MODULE = Class::MOP::Package PACKAGE = Class::MOP::Package
	98
	99	PROTOTYPES: DISABLE
	100
	101	void
	102	get_all_package_symbols(self, filter=TYPE_FILTER_NONE)
	103	SV *self
	104	type_filter_t filter
	105	PREINIT:
	106	HV *stash = NULL;
	107	HV *symbols = NULL;
	108	register HE *he;
	109	PPCODE:
	110	if ( ! SvROK(self) ) {
	111	die("Cannot call get_all_package_symbols as a class method");
	112	}
	113
	114	if (GIMME_V == G_VOID) {
	115	XSRETURN_EMPTY;
	116	}
	117
	118	PUTBACK;
	119
22932438	120	if ( (he = hv_fetch_ent((HV *)SvRV(self), KEY_FOR(package), 0, HASH_FOR(package))) ) {
d846ade3	121	stash = gv_stashsv(HeVAL(he), 0);
	122	}
	123
	124
	125	if (!stash) {
	126	XSRETURN_UNDEF;
	127	}
	128
e1f52a8a	129	symbols = mop_get_all_package_symbols(stash, filter);
d846ade3	130	PUSHs(sv_2mortal(newRV_noinc((SV *)symbols)));
d846ade3	131
7ec7b950	132	BOOT:
7ec7b950	133	INSTALL_SIMPLE_READER_WITH_KEY(Package, name, package);
e170f134	134
	135	SV*
	136	add_package_symbol(SV* self, SV* variable, SV* ref = &PL_sv_undef)
	137	PREINIT:
	138	svtype type;
	139	const char* type_name;
	140	SV* var_name;
	141	SV* package_name;
	142	SV* fq_name;
	143	CODE:
	144	var_name = mop_deconstruct_variable_name(aTHX_ variable, &type, &type_name);
	145
	146	package_name = mop_call0(aTHX_ self, KEY_FOR(name));
	147	if(!SvOK(package_name)){
	148	croak("name() did not return a defined value");
	149	}
	150	fq_name = newSVpvf("%"SVf"::%"SVf, package_name, var_name);
	151	sv_2mortal(fq_name);
	152
	153	if(SvOK(ref)){ /* set */
	154	GV* gv;
	155	if(type == SVt_PV){
	156	if(!SvROK(ref)){
	157	ref = newRV_noinc(newSVsv(ref));
	158	sv_2mortal(ref);
	159	}
	160	}
	161	else if(!(SvROK(ref) && SvTYPE(SvRV(ref)) == type)){
	162	croak("You must pass a reference of %s for the value of %s", type_name, GvNAME(CvGV(cv)));
	163	}
	164	gv = gv_fetchsv(fq_name, GV_ADDMULTI, type);
	165
	166	if(type == SVt_PVCV && GvCV(gv)){
	167	/* XXX: should introduce an option { redefine => 1 } ? */
	168	SvREFCNT_dec(GvCV(gv));
	169	GvCV(gv) = NULL;
	170	}
	171	sv_setsv_mg((SV)gv, ref); / glob = $ref /
	172	RETVAL = ref;
	173	}
	174	else { /* init */
	175	GV* const gv = gv_fetchsv(fq_name, GV_ADDMULTI, type);
	176	SV* sv;
	177
	178	switch(type){
	179	case SVt_PV:
	180	sv = GvSVn(gv);
	181	break;
	182	case SVt_PVAV:
	183	sv = (SV*)GvAVn(gv);
	184	break;
	185	case SVt_PVHV:
	186	sv = (SV*)GvHVn(gv);
	187	break;
	188	case SVt_PVCV:
	189	sv = (SV*)GvCV(gv);
	190	break;
	191	case SVt_PVGV:
	192	sv = (SV*)gv;
	193	break;
	194	case SVt_PVIO:
	195	sv = (SV*)GvIOn(gv);
	196	break;
	197	default:
198	croak("NOT REACHED");
199	sv = NULL; /* -W */
200	break;
201	}
202
203	if(sv){
204	RETVAL = sv_2mortal(newRV_inc(sv));
205	}
206	else{
207	RETVAL = &PL_sv_undef;
208	}
209	}
210	ST(0) = RETVAL;
211
212	SV*
213	get_package_symbol(SV* self, SV* variable)
214	ALIAS:
215	get_package_symbol = GV_ADDMULTI
216	has_package_symbol = 0
217	PREINIT:
218	svtype type;
219	const char* type_name;
220	SV* var_name;
221	SV* package_name;
222	SV* fq_name;
223	GV* gv;
224	SV* sv;
225	CODE:
226	var_name = mop_deconstruct_variable_name(aTHX_ variable, &type, &type_name);
227
228	package_name = mop_call0(aTHX_ self, KEY_FOR(name));
229	if(!SvOK(package_name)){
230	croak("name() did not return a defined value");
231	}
232	fq_name = newSVpvf("%"SVf"::%"SVf, package_name, var_name);
233	sv_2mortal(fq_name);
234
235	gv = gv_fetchsv(fq_name, ix, type);
236	if(!gv){ /* no symbol in has_package_symbol() */
237	XSRETURN_NO;
238	}
239
240	switch(type){
241	case SVt_PV:
242	sv = GvSV(gv);
243	break;
244	case SVt_PVAV:
245	sv = (SV*)GvAV(gv);
246	break;
247	case SVt_PVHV:
248	sv = (SV*)GvHV(gv);
249	break;
250	case SVt_PVCV:
251	sv = (SV*)GvCV(gv);
252	break;
253	case SVt_PVGV:
254	sv = (SV*)gv;
255	break;
256	case SVt_PVIO:
257	sv = (SV*)GvIO(gv);
258	break;
259	default:
260	croak("NOT REACHED");
261	sv = NULL; /* -W */
262	break;
263	}
264
265	if(!ix){ /* has_package_symbol */
266	RETVAL = boolSV(sv);
267	}
268	else{
269	if(sv){
270	RETVAL = newRV_inc(sv);
271	}
272	else{
273	RETVAL = &PL_sv_undef;
274	}
275	}
276	OUTPUT:
277	RETVAL