[gitmo/Package-Stash-XS.git] / Stash.xs

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

typedef enum {
    VAR_NONE = 0,
    VAR_SCALAR,
    VAR_ARRAY,
    VAR_HASH,
    VAR_CODE,
    VAR_IO,
    VAR_GLOB,  /* TODO: unimplemented */
    VAR_FORMAT /* TODO: unimplemented */
} vartype_t;

typedef struct {
    vartype_t type;
    char sigil;
    char *name;
} varspec_t;

vartype_t string_to_vartype(char *vartype)
{
    if (strEQ(vartype, "SCALAR")) {
        return VAR_SCALAR;
    }
    else if (strEQ(vartype, "ARRAY")) {
        return VAR_ARRAY;
    }
    else if (strEQ(vartype, "HASH")) {
        return VAR_HASH;
    }
    else if (strEQ(vartype, "CODE")) {
        return VAR_CODE;
    }
    else if (strEQ(vartype, "IO")) {
        return VAR_IO;
    }
    else {
        croak("Type must be one of 'SCALAR', 'ARRAY', 'HASH', 'CODE', or 'IO'");
    }
}

void _deconstruct_variable_name(char *variable, varspec_t *varspec)
{
    if (!variable || !variable[0])
        croak("You must pass a variable name");

    varspec->type = VAR_NONE;

    switch (variable[0]) {
    case '$':
        varspec->type = VAR_SCALAR;
        break;
    case '@':
        varspec->type = VAR_ARRAY;
        break;
    case '%':
        varspec->type = VAR_HASH;
        break;
    case '&':
        varspec->type = VAR_CODE;
        break;
    }

    if (varspec->type != VAR_NONE) {
        varspec->sigil = variable[0];
        varspec->name = &variable[1];
    }
    else {
        varspec->type = VAR_IO;
        varspec->sigil = '\0';
        varspec->name = variable;
    }
}

void _deconstruct_variable_hash(HV *variable, varspec_t *varspec)
{
    SV **val;
    char *type;

    val = hv_fetch(variable, "name", 4, 0);
    if (!val)
        croak("The 'name' key is required in variable specs");

    varspec->name = savesvpv(*val);

    val = hv_fetch(variable, "sigil", 5, 0);
    if (!val)
        croak("The 'sigil' key is required in variable specs");

    varspec->sigil = (SvPV_nolen(*val))[0];

    val = hv_fetch(variable, "type", 4, 0);
    if (!val)
        croak("The 'type' key is required in variable specs");

    varspec->type = string_to_vartype(SvPV_nolen(*val));
}

int _valid_for_type(SV *value, vartype_t type)
{
    svtype sv_type = SvROK(value) ? SvTYPE(SvRV(value)) : SVt_NULL;

    switch (type) {
    case VAR_SCALAR:
        return sv_type == SVt_NULL ||
               sv_type == SVt_IV   ||
               sv_type == SVt_NV   ||
               sv_type == SVt_PV   ||
               sv_type == SVt_RV;
    case VAR_ARRAY:
        return sv_type == SVt_PVAV;
    case VAR_HASH:
        return sv_type == SVt_PVHV;
    case VAR_CODE:
        return sv_type == SVt_PVCV;
    case VAR_IO:
        return sv_type == SVt_PVGV;
    default:
        return 0;
    }
}

HV *_get_namespace(SV *self)
{
    dSP;
    SV *ret;

    PUSHMARK(SP);
    XPUSHs(self);
    PUTBACK;

    call_method("namespace", G_SCALAR);

    SPAGAIN;
    ret = POPs;
    PUTBACK;

    return (HV*)SvRV(ret);
}

MODULE = Package::Stash  PACKAGE = Package::Stash

PROTOTYPES: DISABLE

SV*
new(class, package_name)
    char *class
    SV *package_name
  PREINIT:
    HV *instance;
    HV *namespace;
  CODE:
    if (!SvPOK(package_name))
        croak("The constructor argument must be the name of a package");

    instance = newHV();

    hv_store(instance, "name", 4, package_name, 0);
    namespace = gv_stashpv(SvPV_nolen(package_name), GV_ADD);
    hv_store(instance, "namespace", 9, newRV((SV*)namespace), 0);

    RETVAL = sv_bless(newRV((SV*)instance), gv_stashpv(class, 0));
  OUTPUT:
    RETVAL

SV*
name(self)
    SV *self
  PREINIT:
    SV **slot;
  CODE:
    if (!sv_isobject(self))
        croak("Can't call name as a class method");
    slot = hv_fetch((HV*)SvRV(self), "name", 4, 0);
    RETVAL = slot ? SvREFCNT_inc(*slot) : &PL_sv_undef;
  OUTPUT:
    RETVAL

SV*
namespace(self)
    SV *self
  PREINIT:
    SV **slot;
  CODE:
    if (!sv_isobject(self))
        croak("Can't call namespace as a class method");
    slot = hv_fetch((HV*)SvRV(self), "namespace", 9, 0);
    RETVAL = slot ? SvREFCNT_inc(*slot) : &PL_sv_undef;
  OUTPUT:
    RETVAL

void
remove_package_glob(self, name)
    SV *self
    char *name
  CODE:
    hv_delete(_get_namespace(self), name, strlen(name), G_DISCARD);

int
has_package_symbol(self, variable)
    SV *self
    varspec_t variable
  PREINIT:
    HV *namespace;
    SV **entry;
  CODE:
    namespace = _get_namespace(self);
    entry = hv_fetch(namespace, variable.name, strlen(variable.name), 0);
    if (!entry)
        XSRETURN_UNDEF;

    if (isGV(*entry)) {
        GV *glob = (GV*)(*entry);
        switch (variable.type) {
        case VAR_SCALAR:
            RETVAL = GvSV(glob) ? 1 : 0;
            break;
        case VAR_ARRAY:
            RETVAL = GvAV(glob) ? 1 : 0;
            break;
        case VAR_HASH:
            RETVAL = GvHV(glob) ? 1 : 0;
            break;
        case VAR_CODE:
            RETVAL = GvCV(glob) ? 1 : 0;
            break;
        case VAR_IO:
            RETVAL = GvIO(glob) ? 1 : 0;
            break;
        }
    }
    else {
        RETVAL = (variable.type == VAR_CODE);
    }
  OUTPUT:
    RETVAL

void
remove_package_symbol(self, variable)
    SV *self
    varspec_t variable
  PREINIT:
    HV *namespace;
    SV **entry;
  CODE:
    namespace = _get_namespace(self);
    entry = hv_fetch(namespace, variable.name, strlen(variable.name), 0);
    if (!entry)
        XSRETURN_EMPTY;

    if (isGV(*entry)) {
        GV *glob = (GV*)(*entry);
        switch (variable.type) {
        case VAR_SCALAR:
            GvSV(glob) = Nullsv;
            break;
        case VAR_ARRAY:
            GvAV(glob) = Nullav;
            break;
        case VAR_HASH:
            GvHV(glob) = Nullhv;
            break;
        case VAR_CODE:
            GvCV(glob) = Nullcv;
            break;
        case VAR_IO:
            GvIOp(glob) = Null(struct io*);
            break;
        }
    }
    else {
        if (variable.type == VAR_CODE) {
            hv_delete(namespace, variable.name, strlen(variable.name), G_DISCARD);
        }
    }

void
list_all_package_symbols(self, vartype=VAR_NONE)
    SV *self
    vartype_t vartype
  PPCODE:
    if (vartype == VAR_NONE) {
        HV *namespace;
        HE *entry;
        int keys;

        namespace = _get_namespace(self);
        keys = hv_iterinit(namespace);
        EXTEND(SP, keys);
        while (entry = hv_iternext(namespace)) {
            mPUSHs(newSVhek(HeKEY_hek(entry)));
        }
    }
    else {
        HV *namespace;
        HE *entry;
        SV *val;
        char *key;
        int len;

        namespace = _get_namespace(self);
        hv_iterinit(namespace);
        while (val = hv_iternextsv(namespace, &key, &len)) {
            GV *gv = (GV*)val;
            if (isGV(gv)) {
                switch (vartype) {
                case VAR_SCALAR:
                    if (GvSV(val))
                        mXPUSHp(key, len);
                    break;
                case VAR_ARRAY:
                    if (GvAV(val))
                        mXPUSHp(key, len);
                    break;
                case VAR_HASH:
                    if (GvHV(val))
                        mXPUSHp(key, len);
                    break;
                case VAR_CODE:
                    if (GvCVu(val))
                        mXPUSHp(key, len);
                    break;
                case VAR_IO:
                    if (GvIO(val))
                        mXPUSHp(key, len);
                    break;
                }
            }
            else if (vartype == VAR_CODE) {
                mXPUSHp(key, len);
            }
        }
    }
Commit	Line	Data
59017825	1	#include "EXTERN.h"
	2	#include "perl.h"
	3	#include "XSUB.h"
	4
a382a84b	5	typedef enum {
	6	VAR_NONE = 0,
	7	VAR_SCALAR,
	8	VAR_ARRAY,
	9	VAR_HASH,
	10	VAR_CODE,
	11	VAR_IO,
	12	VAR_GLOB, /* TODO: unimplemented */
	13	VAR_FORMAT /* TODO: unimplemented */
	14	} vartype_t;
	15
	16	typedef struct {
	17	vartype_t type;
	18	char sigil;
	19	char *name;
	20	} varspec_t;
	21
	22	vartype_t string_to_vartype(char *vartype)
	23	{
	24	if (strEQ(vartype, "SCALAR")) {
	25	return VAR_SCALAR;
	26	}
	27	else if (strEQ(vartype, "ARRAY")) {
	28	return VAR_ARRAY;
	29	}
	30	else if (strEQ(vartype, "HASH")) {
	31	return VAR_HASH;
	32	}
	33	else if (strEQ(vartype, "CODE")) {
	34	return VAR_CODE;
	35	}
	36	else if (strEQ(vartype, "IO")) {
	37	return VAR_IO;
	38	}
	39	else {
	40	croak("Type must be one of 'SCALAR', 'ARRAY', 'HASH', 'CODE', or 'IO'");
	41	}
	42	}
	43
	44	void _deconstruct_variable_name(char variable, varspec_t varspec)
	45	{
	46	if (!variable \|\| !variable[0])
	47	croak("You must pass a variable name");
	48
	49	varspec->type = VAR_NONE;
	50
	51	switch (variable[0]) {
	52	case '$':
	53	varspec->type = VAR_SCALAR;
	54	break;
	55	case '@':
	56	varspec->type = VAR_ARRAY;
	57	break;
	58	case '%':
	59	varspec->type = VAR_HASH;
	60	break;
	61	case '&':
	62	varspec->type = VAR_CODE;
	63	break;
	64	}
	65
	66	if (varspec->type != VAR_NONE) {
	67	varspec->sigil = variable[0];
	68	varspec->name = &variable[1];
69	}
70	else {
71	varspec->type = VAR_IO;
72	varspec->sigil = '\0';
73	varspec->name = variable;
74	}
75	}
76
77	void _deconstruct_variable_hash(HV variable, varspec_t varspec)
78	{
79	SV **val;
80	char *type;
81
82	val = hv_fetch(variable, "name", 4, 0);
83	if (!val)
84	croak("The 'name' key is required in variable specs");
85
86	varspec->name = savesvpv(*val);
87
88	val = hv_fetch(variable, "sigil", 5, 0);
89	if (!val)
90	croak("The 'sigil' key is required in variable specs");
91
92	varspec->sigil = (SvPV_nolen(*val))[0];
93
94	val = hv_fetch(variable, "type", 4, 0);
95	if (!val)
96	croak("The 'type' key is required in variable specs");
97
98	varspec->type = string_to_vartype(SvPV_nolen(*val));
99	}
100
101	int _valid_for_type(SV *value, vartype_t type)
102	{
103	svtype sv_type = SvROK(value) ? SvTYPE(SvRV(value)) : SVt_NULL;
104
105	switch (type) {
106	case VAR_SCALAR:
107	return sv_type == SVt_NULL \|\|
108	sv_type == SVt_IV \|\|
109	sv_type == SVt_NV \|\|
110	sv_type == SVt_PV \|\|
111	sv_type == SVt_RV;
112	case VAR_ARRAY:
113	return sv_type == SVt_PVAV;
114	case VAR_HASH:
115	return sv_type == SVt_PVHV;
116	case VAR_CODE:
117	return sv_type == SVt_PVCV;
118	case VAR_IO:
119	return sv_type == SVt_PVGV;
120	default:
121	return 0;
122	}
123	}
124
3fd56b4d	125	HV _get_namespace(SV self)
	126	{
	127	dSP;
	128	SV *ret;
	129
	130	PUSHMARK(SP);
	131	XPUSHs(self);
	132	PUTBACK;
	133
	134	call_method("namespace", G_SCALAR);
	135
	136	SPAGAIN;
	137	ret = POPs;
	138	PUTBACK;
	139
	140	return (HV*)SvRV(ret);
	141	}
	142
59017825	143	MODULE = Package::Stash PACKAGE = Package::Stash
59017825	144
be2a7e99	145	PROTOTYPES: DISABLE
be2a7e99	146
59017825	147	SV*
	148	new(class, package_name)
	149	char *class
	150	SV *package_name
3496f1e8	151	PREINIT:
59017825	152	HV *instance;
	153	HV *namespace;
	154	CODE:
	155	if (!SvPOK(package_name))
	156	croak("The constructor argument must be the name of a package");
	157
	158	instance = newHV();
	159
	160	hv_store(instance, "name", 4, package_name, 0);
	161	namespace = gv_stashpv(SvPV_nolen(package_name), GV_ADD);
	162	hv_store(instance, "namespace", 9, newRV((SV*)namespace), 0);
	163
	164	RETVAL = sv_bless(newRV((SV*)instance), gv_stashpv(class, 0));
	165	OUTPUT:
	166	RETVAL
194acf47	167
	168	SV*
	169	name(self)
	170	SV *self
3496f1e8	171	PREINIT:
194acf47	172	SV **slot;
	173	CODE:
	174	if (!sv_isobject(self))
	175	croak("Can't call name as a class method");
	176	slot = hv_fetch((HV*)SvRV(self), "name", 4, 0);
	177	RETVAL = slot ? SvREFCNT_inc(*slot) : &PL_sv_undef;
	178	OUTPUT:
	179	RETVAL
	180
	181	SV*
	182	namespace(self)
	183	SV *self
3496f1e8	184	PREINIT:
194acf47	185	SV **slot;
	186	CODE:
	187	if (!sv_isobject(self))
	188	croak("Can't call namespace as a class method");
	189	slot = hv_fetch((HV*)SvRV(self), "namespace", 9, 0);
	190	RETVAL = slot ? SvREFCNT_inc(*slot) : &PL_sv_undef;
	191	OUTPUT:
	192	RETVAL
3fd56b4d	193
	194	void
	195	remove_package_glob(self, name)
	196	SV *self
	197	char *name
3fd56b4d	198	CODE:
3fd56b4d	199	hv_delete(_get_namespace(self), name, strlen(name), G_DISCARD);
9b608466	200
34805376	201	int
	202	has_package_symbol(self, variable)
	203	SV *self
	204	varspec_t variable
	205	PREINIT:
	206	HV *namespace;
	207	SV **entry;
	208	CODE:
	209	namespace = _get_namespace(self);
	210	entry = hv_fetch(namespace, variable.name, strlen(variable.name), 0);
	211	if (!entry)
	212	XSRETURN_UNDEF;
	213
	214	if (isGV(*entry)) {
	215	GV glob = (GV)(*entry);
	216	switch (variable.type) {
	217	case VAR_SCALAR:
	218	RETVAL = GvSV(glob) ? 1 : 0;
	219	break;
	220	case VAR_ARRAY:
	221	RETVAL = GvAV(glob) ? 1 : 0;
	222	break;
	223	case VAR_HASH:
	224	RETVAL = GvHV(glob) ? 1 : 0;
	225	break;
	226	case VAR_CODE:
	227	RETVAL = GvCV(glob) ? 1 : 0;
	228	break;
	229	case VAR_IO:
	230	RETVAL = GvIO(glob) ? 1 : 0;
	231	break;
	232	}
	233	}
	234	else {
	235	RETVAL = (variable.type == VAR_CODE);
	236	}
	237	OUTPUT:
	238	RETVAL
	239
9b608466	240	void
215f49f8	241	remove_package_symbol(self, variable)
	242	SV *self
	243	varspec_t variable
	244	PREINIT:
	245	HV *namespace;
	246	SV **entry;
	247	CODE:
	248	namespace = _get_namespace(self);
	249	entry = hv_fetch(namespace, variable.name, strlen(variable.name), 0);
	250	if (!entry)
	251	XSRETURN_EMPTY;
	252
	253	if (isGV(*entry)) {
	254	GV glob = (GV)(*entry);
	255	switch (variable.type) {
	256	case VAR_SCALAR:
	257	GvSV(glob) = Nullsv;
	258	break;
	259	case VAR_ARRAY:
	260	GvAV(glob) = Nullav;
	261	break;
	262	case VAR_HASH:
	263	GvHV(glob) = Nullhv;
	264	break;
	265	case VAR_CODE:
	266	GvCV(glob) = Nullcv;
	267	break;
	268	case VAR_IO:
	269	GvIOp(glob) = Null(struct io*);
	270	break;
	271	}
	272	}
	273	else {
	274	if (variable.type == VAR_CODE) {
	275	hv_delete(namespace, variable.name, strlen(variable.name), G_DISCARD);
	276	}
	277	}
	278
	279	void
9b608466	280	list_all_package_symbols(self, vartype=VAR_NONE)
	281	SV *self
	282	vartype_t vartype
	283	PPCODE:
	284	if (vartype == VAR_NONE) {
	285	HV *namespace;
	286	HE *entry;
	287	int keys;
	288
	289	namespace = _get_namespace(self);
	290	keys = hv_iterinit(namespace);
	291	EXTEND(SP, keys);
	292	while (entry = hv_iternext(namespace)) {
	293	mPUSHs(newSVhek(HeKEY_hek(entry)));
	294	}
	295	}
	296	else {
	297	HV *namespace;
	298	HE *entry;
	299	SV *val;
	300	char *key;
	301	int len;
	302
	303	namespace = _get_namespace(self);
	304	hv_iterinit(namespace);
	305	while (val = hv_iternextsv(namespace, &key, &len)) {
	306	GV gv = (GV)val;
	307	if (isGV(gv)) {
	308	switch (vartype) {
	309	case VAR_SCALAR:
	310	if (GvSV(val))
	311	mXPUSHp(key, len);
	312	break;
	313	case VAR_ARRAY:
	314	if (GvAV(val))
	315	mXPUSHp(key, len);
	316	break;
	317	case VAR_HASH:
	318	if (GvHV(val))
	319	mXPUSHp(key, len);
	320	break;
	321	case VAR_CODE:
	322	if (GvCVu(val))
	323	mXPUSHp(key, len);
	324	break;
	325	case VAR_IO:
	326	if (GvIO(val))
	327	mXPUSHp(key, len);
	328	break;
	329	}
	330	}
	331	else if (vartype == VAR_CODE) {
	332	mXPUSHp(key, len);
	333	}
	334	}
	335	}