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

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

#define NEED_newRV_noinc
#define NEED_sv_2pv_flags
#include "ppport.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;

const char *vartype_to_string(vartype_t type)
{
    switch (type) {
    case VAR_SCALAR:
        return "SCALAR";
    case VAR_ARRAY:
        return "ARRAY";
    case VAR_HASH:
        return "HASH";
    case VAR_CODE:
        return "CODE";
    case VAR_IO:
        return "IO";
    default:
        return "unknown";
    }
}

I32 vartype_to_svtype(vartype_t type)
{
    switch (type) {
    case VAR_SCALAR:
        return SVt_PV; /* or whatever */
    case VAR_ARRAY:
        return SVt_PVAV;
    case VAR_HASH:
        return SVt_PVHV;
    case VAR_CODE:
        return SVt_PVCV;
    case VAR_IO:
        return SVt_PVIO;
    default:
        return SVt_NULL;
    }
}

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;

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

    varspec->name = savesvpv(*val);
    SAVEFREEPV(varspec->name);

    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_PVIO;
    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);
}

SV *_get_name(SV *self)
{
    dSP;
    SV *ret;

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

    call_method("name", G_SCALAR);

    SPAGAIN;
    ret = POPs;
    PUTBACK;

    return ret;
}

SV *_get_symbol(SV *self, varspec_t *variable, int vivify)
{
    HV *namespace;
    SV **entry;
    GV *glob;

    namespace = _get_namespace(self);
    entry = hv_fetch(namespace, variable->name, strlen(variable->name), vivify);
    if (!entry)
        return NULL;

    glob = (GV*)(*entry);
    if (!isGV(glob)) {
        SV *namesv;

        namesv = newSVsv(_get_name(self));
        sv_catpvs(namesv, "::");
        sv_catpv(namesv, variable->name);

        /* can't use gv_init here, because it screws up @ISA in a way that I
         * can't reproduce, but that CMOP triggers */
        gv_fetchsv(namesv, GV_ADD, vartype_to_svtype(variable->type));
        SvREFCNT_dec(namesv);
    }

    if (vivify) {
        switch (variable->type) {
        case VAR_SCALAR:
            if (!GvSV(glob))
                GvSV(glob) = newSV(0);
            break;
        case VAR_ARRAY:
            if (!GvAV(glob))
                GvAV(glob) = newAV();
            break;
        case VAR_HASH:
            if (!GvHV(glob))
                GvHV(glob) = newHV();
            break;
        case VAR_CODE:
            croak("Don't know how to vivify CODE variables");
        case VAR_IO:
            if (!GvIO(glob))
                GvIOp(glob) = newIO();
            break;
        default:
            croak("Unknown type in vivication");
        }
    }

    switch (variable->type) {
    case VAR_SCALAR:
        return GvSV(glob);
    case VAR_ARRAY:
        return (SV*)GvAV(glob);
    case VAR_HASH:
        return (SV*)GvHV(glob);
    case VAR_CODE:
        return (SV*)GvCV(glob);
    case VAR_IO:
        return (SV*)GvIO(glob);
    default:
        return NULL;
    }
}

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

PROTOTYPES: DISABLE

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

    instance = newHV();

    if (!hv_store(instance, "name", 4, SvREFCNT_inc_simple_NN(package_name), 0)) {
        SvREFCNT_dec(package_name);
        SvREFCNT_dec(instance);
        croak("Couldn't initialize the 'name' key, hv_store failed");
    }
    namespace = gv_stashpv(SvPV_nolen(package_name), GV_ADD);
    nsref = newRV_inc((SV*)namespace);
    if (!hv_store(instance, "namespace", 9, nsref, 0)) {
        SvREFCNT_dec(nsref);
        SvREFCNT_dec(instance);
        croak("Couldn't initialize the 'namespace' key, hv_store failed");
    }

    RETVAL = sv_bless(newRV_noinc((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_simple_NN(*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_simple_NN(*slot) : &PL_sv_undef;
  OUTPUT:
    RETVAL

void
add_symbol(self, variable, initial=NULL, ...)
    SV *self
    varspec_t variable
    SV *initial
  PREINIT:
    SV *name;
    GV *glob;
  CODE:
    if (initial && !_valid_for_type(initial, variable.type))
        croak("%s is not of type %s",
              SvPV_nolen(initial), vartype_to_string(variable.type));

    name = newSVsv(_get_name(self));
    sv_catpvs(name, "::");
    sv_catpv(name, variable.name);

    /* XXX: come back to this when i feel like reimplementing caller() */
/*
    my $filename = $opts{filename};
    my $first_line_num = $opts{first_line_num};

    (undef, $filename, $first_line_num) = caller
        if not defined $filename;

    my $last_line_num = $opts{last_line_num} || ($first_line_num ||= 0);

    # http://perldoc.perl.org/perldebguts.html#Debugger-Internals
    $DB::sub{$pkg . '::' . $name} = "$filename:$first_line_num-$last_line_num";
*/
/*
    if (items > 2 && (PL_perldb & 0x10) && variable.type == VAR_CODE) {
        int i;
        char *filename = NULL, *name;
        I32 first_line_num, last_line_num;

        if ((items - 3) % 2)
            croak("add_symbol: Odd number of elements in %%opts");

        for (i = 3; i < items; i += 2) {
            char *key;
            key = SvPV_nolen(ST(i));
            if (strEQ(key, "filename")) {
                if (!SvPOK(ST(i + 1)))
                    croak("add_symbol: filename must be a string");
                filename = SvPV_nolen(ST(i + 1));
            }
            else if (strEQ(key, "first_line_num")) {
                if (!SvIOK(ST(i + 1)))
                    croak("add_symbol: first_line_num must be an integer");
                first_line_num = SvIV(ST(i + 1));
            }
            else if (strEQ(key, "last_line_num")) {
                if (!SvIOK(ST(i + 1)))
                    croak("add_symbol: last_line_num must be an integer");
                last_line_num = SvIV(ST(i + 1));
            }
        }

        if (!filename) {
        }
    }
*/

    glob = gv_fetchsv(name, GV_ADDMULTI, vartype_to_svtype(variable.type));

    if (initial) {
        SV *val;

        if (SvROK(initial)) {
            val = SvRV(initial);
            SvREFCNT_inc_simple_void_NN(val);
        }
        else {
            val = newSVsv(initial);
        }

        switch (variable.type) {
        case VAR_SCALAR:
            SvREFCNT_dec(GvSV(glob));
            GvSV(glob) = val;
            GvIMPORTED_SV_on(glob);
            break;
        case VAR_ARRAY:
            SvREFCNT_dec(GvAV(glob));
            GvAV(glob) = (AV*)val;
            GvIMPORTED_AV_on(glob);
            break;
        case VAR_HASH:
            SvREFCNT_dec(GvHV(glob));
            GvHV(glob) = (HV*)val;
            GvIMPORTED_HV_on(glob);
            break;
        case VAR_CODE:
            SvREFCNT_dec(GvCV(glob));
            GvCV(glob) = (CV*)val;
            GvIMPORTED_CV_on(glob);
            GvASSUMECV_on(glob);
            GvCVGEN(glob) = 0;
            mro_method_changed_in(GvSTASH(glob));
            break;
        case VAR_IO:
            SvREFCNT_dec(GvIO(glob));
            GvIOp(glob) = (IO*)val;
            break;
        }
    }

    SvREFCNT_dec(name);

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

int
has_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

SV*
get_symbol(self, variable)
    SV *self
    varspec_t variable
  PREINIT:
    SV *val;
  CODE:
    val = _get_symbol(self, &variable, 0);
    if (!val)
        XSRETURN_UNDEF;
    RETVAL = newRV_inc(val);
  OUTPUT:
    RETVAL

SV*
get_or_add_symbol(self, variable)
    SV *self
    varspec_t variable
  PREINIT:
    SV *val;
  CODE:
    val = _get_symbol(self, &variable, 1);
    if (!val)
        XSRETURN_UNDEF;
    RETVAL = newRV_inc(val);
  OUTPUT:
    RETVAL

void
remove_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) = (SV *)NULL;
            break;
        case VAR_ARRAY:
            GvAV(glob) = (AV *)NULL;
            break;
        case VAR_HASH:
            GvHV(glob) = (HV *)NULL;
            break;
        case VAR_CODE:
            GvCV(glob) = (CV *)NULL;
            GvCVGEN(glob) = 0;
            mro_method_changed_in(GvSTASH(glob));
            break;
        case VAR_IO:
            GvIOp(glob) = (IO *)NULL;
            break;
        }
    }
    else {
        if (variable.type == VAR_CODE) {
            hv_delete(namespace, variable.name, strlen(variable.name), G_DISCARD);
        }
    }

void
list_all_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;
        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
dfabcbae	5	#define NEED_newRV_noinc
	6	#define NEED_sv_2pv_flags
	7	#include "ppport.h"
	8
a382a84b	9	typedef enum {
	10	VAR_NONE = 0,
	11	VAR_SCALAR,
	12	VAR_ARRAY,
	13	VAR_HASH,
	14	VAR_CODE,
	15	VAR_IO,
	16	VAR_GLOB, /* TODO: unimplemented */
	17	VAR_FORMAT /* TODO: unimplemented */
	18	} vartype_t;
	19
	20	typedef struct {
	21	vartype_t type;
	22	char sigil;
	23	char *name;
	24	} varspec_t;
	25
76f7c306	26	const char *vartype_to_string(vartype_t type)
	27	{
	28	switch (type) {
	29	case VAR_SCALAR:
	30	return "SCALAR";
	31	case VAR_ARRAY:
	32	return "ARRAY";
	33	case VAR_HASH:
	34	return "HASH";
	35	case VAR_CODE:
	36	return "CODE";
	37	case VAR_IO:
	38	return "IO";
	39	default:
	40	return "unknown";
	41	}
	42	}
	43
	44	I32 vartype_to_svtype(vartype_t type)
	45	{
	46	switch (type) {
	47	case VAR_SCALAR:
	48	return SVt_PV; /* or whatever */
	49	case VAR_ARRAY:
	50	return SVt_PVAV;
	51	case VAR_HASH:
	52	return SVt_PVHV;
	53	case VAR_CODE:
	54	return SVt_PVCV;
	55	case VAR_IO:
	56	return SVt_PVIO;
	57	default:
	58	return SVt_NULL;
	59	}
	60	}
	61
a382a84b	62	vartype_t string_to_vartype(char *vartype)
	63	{
	64	if (strEQ(vartype, "SCALAR")) {
	65	return VAR_SCALAR;
	66	}
	67	else if (strEQ(vartype, "ARRAY")) {
	68	return VAR_ARRAY;
	69	}
	70	else if (strEQ(vartype, "HASH")) {
	71	return VAR_HASH;
	72	}
	73	else if (strEQ(vartype, "CODE")) {
	74	return VAR_CODE;
	75	}
	76	else if (strEQ(vartype, "IO")) {
	77	return VAR_IO;
	78	}
	79	else {
	80	croak("Type must be one of 'SCALAR', 'ARRAY', 'HASH', 'CODE', or 'IO'");
	81	}
	82	}
	83
	84	void _deconstruct_variable_name(char variable, varspec_t varspec)
	85	{
	86	if (!variable \|\| !variable[0])
	87	croak("You must pass a variable name");
	88
	89	varspec->type = VAR_NONE;
	90
	91	switch (variable[0]) {
	92	case '$':
	93	varspec->type = VAR_SCALAR;
	94	break;
	95	case '@':
	96	varspec->type = VAR_ARRAY;
	97	break;
	98	case '%':
	99	varspec->type = VAR_HASH;
	100	break;
	101	case '&':
	102	varspec->type = VAR_CODE;
	103	break;
	104	}
	105
	106	if (varspec->type != VAR_NONE) {
	107	varspec->sigil = variable[0];
	108	varspec->name = &variable[1];
	109	}
	110	else {
	111	varspec->type = VAR_IO;
	112	varspec->sigil = '\0';
	113	varspec->name = variable;
	114	}
	115	}
	116
	117	void _deconstruct_variable_hash(HV variable, varspec_t varspec)
	118	{
	119	SV **val;
a382a84b	120
	121	val = hv_fetch(variable, "name", 4, 0);
	122	if (!val)
	123	croak("The 'name' key is required in variable specs");
	124
	125	varspec->name = savesvpv(*val);
301f570b	126	SAVEFREEPV(varspec->name);
a382a84b	127
	128	val = hv_fetch(variable, "sigil", 5, 0);
	129	if (!val)
	130	croak("The 'sigil' key is required in variable specs");
	131
	132	varspec->sigil = (SvPV_nolen(*val))[0];
	133
	134	val = hv_fetch(variable, "type", 4, 0);
	135	if (!val)
	136	croak("The 'type' key is required in variable specs");
	137
	138	varspec->type = string_to_vartype(SvPV_nolen(*val));
	139	}
	140
	141	int _valid_for_type(SV *value, vartype_t type)
	142	{
	143	svtype sv_type = SvROK(value) ? SvTYPE(SvRV(value)) : SVt_NULL;
	144
	145	switch (type) {
	146	case VAR_SCALAR:
	147	return sv_type == SVt_NULL \|\|
	148	sv_type == SVt_IV \|\|
	149	sv_type == SVt_NV \|\|
	150	sv_type == SVt_PV \|\|
	151	sv_type == SVt_RV;
	152	case VAR_ARRAY:
	153	return sv_type == SVt_PVAV;
	154	case VAR_HASH:
	155	return sv_type == SVt_PVHV;
	156	case VAR_CODE:
	157	return sv_type == SVt_PVCV;
	158	case VAR_IO:
76f7c306	159	return sv_type == SVt_PVIO;
a382a84b	160	default:
	161	return 0;
	162	}
	163	}
	164
3fd56b4d	165	HV _get_namespace(SV self)
	166	{
	167	dSP;
	168	SV *ret;
	169
	170	PUSHMARK(SP);
	171	XPUSHs(self);
	172	PUTBACK;
	173
612dcf3b	174	call_method("namespace", G_SCALAR);
3fd56b4d	175
	176	SPAGAIN;
	177	ret = POPs;
	178	PUTBACK;
	179
	180	return (HV*)SvRV(ret);
	181	}
	182
76f7c306	183	SV _get_name(SV self)
	184	{
	185	dSP;
	186	SV *ret;
	187
	188	PUSHMARK(SP);
	189	XPUSHs(self);
	190	PUTBACK;
	191
612dcf3b	192	call_method("name", G_SCALAR);
76f7c306	193
	194	SPAGAIN;
	195	ret = POPs;
	196	PUTBACK;
	197
	198	return ret;
	199	}
	200
15c104e2	201	SV _get_symbol(SV self, varspec_t *variable, int vivify)
4871b1a0	202	{
	203	HV *namespace;
	204	SV **entry;
	205	GV *glob;
	206
	207	namespace = _get_namespace(self);
	208	entry = hv_fetch(namespace, variable->name, strlen(variable->name), vivify);
	209	if (!entry)
	210	return NULL;
	211
	212	glob = (GV)(entry);
	213	if (!isGV(glob)) {
	214	SV *namesv;
4871b1a0	215
	216	namesv = newSVsv(_get_name(self));
	217	sv_catpvs(namesv, "::");
	218	sv_catpv(namesv, variable->name);
	219
b55c97c2	220	/* can't use gv_init here, because it screws up @ISA in a way that I
	221	* can't reproduce, but that CMOP triggers */
	222	gv_fetchsv(namesv, GV_ADD, vartype_to_svtype(variable->type));
02b2a57f	223	SvREFCNT_dec(namesv);
4871b1a0	224	}
	225
	226	if (vivify) {
	227	switch (variable->type) {
	228	case VAR_SCALAR:
	229	if (!GvSV(glob))
	230	GvSV(glob) = newSV(0);
	231	break;
	232	case VAR_ARRAY:
	233	if (!GvAV(glob))
	234	GvAV(glob) = newAV();
	235	break;
	236	case VAR_HASH:
	237	if (!GvHV(glob))
	238	GvHV(glob) = newHV();
	239	break;
	240	case VAR_CODE:
	241	croak("Don't know how to vivify CODE variables");
	242	case VAR_IO:
	243	if (!GvIO(glob))
	244	GvIOp(glob) = newIO();
	245	break;
	246	default:
	247	croak("Unknown type in vivication");
	248	}
	249	}
	250
	251	switch (variable->type) {
	252	case VAR_SCALAR:
	253	return GvSV(glob);
	254	case VAR_ARRAY:
	255	return (SV*)GvAV(glob);
	256	case VAR_HASH:
	257	return (SV*)GvHV(glob);
	258	case VAR_CODE:
	259	return (SV*)GvCV(glob);
	260	case VAR_IO:
	261	return (SV*)GvIO(glob);
	262	default:
	263	return NULL;
	264	}
	265	}
	266
59017825	267	MODULE = Package::Stash PACKAGE = Package::Stash
59017825	268
be2a7e99	269	PROTOTYPES: DISABLE
be2a7e99	270
59017825	271	SV*
	272	new(class, package_name)
	273	char *class
	274	SV *package_name
3496f1e8	275	PREINIT:
59017825	276	HV *instance;
59017825	277	HV *namespace;
1d6c978b	278	SV *nsref;
59017825	279	CODE:
	280	if (!SvPOK(package_name))
	281	croak("The constructor argument must be the name of a package");
	282
6c3e69c6	283	instance = newHV();
59017825	284
1d6c978b	285	if (!hv_store(instance, "name", 4, SvREFCNT_inc_simple_NN(package_name), 0)) {
1d6c978b	286	SvREFCNT_dec(package_name);
c86a1630	287	SvREFCNT_dec(instance);
e8d57afd	288	croak("Couldn't initialize the 'name' key, hv_store failed");
1d6c978b	289	}
59017825	290	namespace = gv_stashpv(SvPV_nolen(package_name), GV_ADD);
1d6c978b	291	nsref = newRV_inc((SV*)namespace);
	292	if (!hv_store(instance, "namespace", 9, nsref, 0)) {
	293	SvREFCNT_dec(nsref);
c86a1630	294	SvREFCNT_dec(instance);
e8d57afd	295	croak("Couldn't initialize the 'namespace' key, hv_store failed");
1d6c978b	296	}
59017825	297
6c3e69c6	298	RETVAL = sv_bless(newRV_noinc((SV*)instance), gv_stashpv(class, 0));
59017825	299	OUTPUT:
59017825	300	RETVAL
194acf47	301
	302	SV*
	303	name(self)
	304	SV *self
3496f1e8	305	PREINIT:
194acf47	306	SV **slot;
	307	CODE:
	308	if (!sv_isobject(self))
	309	croak("Can't call name as a class method");
	310	slot = hv_fetch((HV*)SvRV(self), "name", 4, 0);
a2fec41a	311	RETVAL = slot ? SvREFCNT_inc_simple_NN(*slot) : &PL_sv_undef;
194acf47	312	OUTPUT:
	313	RETVAL
	314
	315	SV*
	316	namespace(self)
	317	SV *self
3496f1e8	318	PREINIT:
194acf47	319	SV **slot;
	320	CODE:
	321	if (!sv_isobject(self))
	322	croak("Can't call namespace as a class method");
	323	slot = hv_fetch((HV*)SvRV(self), "namespace", 9, 0);
a2fec41a	324	RETVAL = slot ? SvREFCNT_inc_simple_NN(*slot) : &PL_sv_undef;
194acf47	325	OUTPUT:
194acf47	326	RETVAL
3fd56b4d	327
3fd56b4d	328	void
15c104e2	329	add_symbol(self, variable, initial=NULL, ...)
76f7c306	330	SV *self
	331	varspec_t variable
	332	SV *initial
	333	PREINIT:
	334	SV *name;
	335	GV *glob;
	336	CODE:
	337	if (initial && !_valid_for_type(initial, variable.type))
	338	croak("%s is not of type %s",
	339	SvPV_nolen(initial), vartype_to_string(variable.type));
	340
	341	name = newSVsv(_get_name(self));
	342	sv_catpvs(name, "::");
	343	sv_catpv(name, variable.name);
	344
	345	/* XXX: come back to this when i feel like reimplementing caller() */
	346	/*
	347	my $filename = $opts{filename};
	348	my $first_line_num = $opts{first_line_num};
	349
	350	(undef, $filename, $first_line_num) = caller
	351	if not defined $filename;
	352
	353	my $last_line_num = $opts{last_line_num} \|\| ($first_line_num \|\|= 0);
	354
	355	# http://perldoc.perl.org/perldebguts.html#Debugger-Internals
	356	$DB::sub{$pkg . '::' . $name} = "$filename:$first_line_num-$last_line_num";
	357	*/
	358	/*
	359	if (items > 2 && (PL_perldb & 0x10) && variable.type == VAR_CODE) {
	360	int i;
	361	char filename = NULL, name;
	362	I32 first_line_num, last_line_num;
	363
	364	if ((items - 3) % 2)
15c104e2	365	croak("add_symbol: Odd number of elements in %%opts");
76f7c306	366
	367	for (i = 3; i < items; i += 2) {
	368	char *key;
	369	key = SvPV_nolen(ST(i));
	370	if (strEQ(key, "filename")) {
	371	if (!SvPOK(ST(i + 1)))
15c104e2	372	croak("add_symbol: filename must be a string");
76f7c306	373	filename = SvPV_nolen(ST(i + 1));
	374	}
	375	else if (strEQ(key, "first_line_num")) {
	376	if (!SvIOK(ST(i + 1)))
15c104e2	377	croak("add_symbol: first_line_num must be an integer");
76f7c306	378	first_line_num = SvIV(ST(i + 1));
	379	}
	380	else if (strEQ(key, "last_line_num")) {
	381	if (!SvIOK(ST(i + 1)))
15c104e2	382	croak("add_symbol: last_line_num must be an integer");
76f7c306	383	last_line_num = SvIV(ST(i + 1));
	384	}
	385	}
	386
	387	if (!filename) {
	388	}
	389	}
	390	*/
	391
fedea7f9	392	glob = gv_fetchsv(name, GV_ADDMULTI, vartype_to_svtype(variable.type));
76f7c306	393
	394	if (initial) {
	395	SV *val;
	396
	397	if (SvROK(initial)) {
	398	val = SvRV(initial);
a2fec41a	399	SvREFCNT_inc_simple_void_NN(val);
76f7c306	400	}
	401	else {
	402	val = newSVsv(initial);
	403	}
	404
	405	switch (variable.type) {
	406	case VAR_SCALAR:
a2fec41a	407	SvREFCNT_dec(GvSV(glob));
76f7c306	408	GvSV(glob) = val;
02b4c373	409	GvIMPORTED_SV_on(glob);
76f7c306	410	break;
76f7c306	411	case VAR_ARRAY:
6cce0a02	412	SvREFCNT_dec(GvAV(glob));
76f7c306	413	GvAV(glob) = (AV*)val;
02b4c373	414	GvIMPORTED_AV_on(glob);
76f7c306	415	break;
76f7c306	416	case VAR_HASH:
6cce0a02	417	SvREFCNT_dec(GvHV(glob));
76f7c306	418	GvHV(glob) = (HV*)val;
02b4c373	419	GvIMPORTED_HV_on(glob);
76f7c306	420	break;
76f7c306	421	case VAR_CODE:
6cce0a02	422	SvREFCNT_dec(GvCV(glob));
76f7c306	423	GvCV(glob) = (CV*)val;
02b4c373	424	GvIMPORTED_CV_on(glob);
	425	GvASSUMECV_on(glob);
	426	GvCVGEN(glob) = 0;
	427	mro_method_changed_in(GvSTASH(glob));
76f7c306	428	break;
76f7c306	429	case VAR_IO:
6cce0a02	430	SvREFCNT_dec(GvIO(glob));
76f7c306	431	GvIOp(glob) = (IO*)val;
	432	break;
	433	}
	434	}
	435
5bb2b07b	436	SvREFCNT_dec(name);
5bb2b07b	437
76f7c306	438	void
15c104e2	439	remove_glob(self, name)
3fd56b4d	440	SV *self
3fd56b4d	441	char *name
3fd56b4d	442	CODE:
3fd56b4d	443	hv_delete(_get_namespace(self), name, strlen(name), G_DISCARD);
9b608466	444
34805376	445	int
15c104e2	446	has_symbol(self, variable)
34805376	447	SV *self
	448	varspec_t variable
	449	PREINIT:
	450	HV *namespace;
	451	SV **entry;
	452	CODE:
	453	namespace = _get_namespace(self);
	454	entry = hv_fetch(namespace, variable.name, strlen(variable.name), 0);
	455	if (!entry)
	456	XSRETURN_UNDEF;
	457
	458	if (isGV(*entry)) {
	459	GV glob = (GV)(*entry);
	460	switch (variable.type) {
	461	case VAR_SCALAR:
	462	RETVAL = GvSV(glob) ? 1 : 0;
	463	break;
	464	case VAR_ARRAY:
	465	RETVAL = GvAV(glob) ? 1 : 0;
	466	break;
	467	case VAR_HASH:
	468	RETVAL = GvHV(glob) ? 1 : 0;
	469	break;
	470	case VAR_CODE:
	471	RETVAL = GvCV(glob) ? 1 : 0;
	472	break;
	473	case VAR_IO:
	474	RETVAL = GvIO(glob) ? 1 : 0;
	475	break;
	476	}
	477	}
	478	else {
	479	RETVAL = (variable.type == VAR_CODE);
	480	}
	481	OUTPUT:
	482	RETVAL
	483
e3ad44fd	484	SV*
15c104e2	485	get_symbol(self, variable)
e3ad44fd	486	SV *self
	487	varspec_t variable
	488	PREINIT:
fca4ed0c	489	SV *val;
e3ad44fd	490	CODE:
15c104e2	491	val = _get_symbol(self, &variable, 0);
4871b1a0	492	if (!val)
e3ad44fd	493	XSRETURN_UNDEF;
93c36417	494	RETVAL = newRV_inc(val);
4871b1a0	495	OUTPUT:
4871b1a0	496	RETVAL
e3ad44fd	497
4871b1a0	498	SV*
15c104e2	499	get_or_add_symbol(self, variable)
4871b1a0	500	SV *self
	501	varspec_t variable
	502	PREINIT:
	503	SV *val;
	504	CODE:
15c104e2	505	val = _get_symbol(self, &variable, 1);
fca4ed0c	506	if (!val)
fca4ed0c	507	XSRETURN_UNDEF;
93c36417	508	RETVAL = newRV_inc(val);
e3ad44fd	509	OUTPUT:
	510	RETVAL
	511
9b608466	512	void
15c104e2	513	remove_symbol(self, variable)
215f49f8	514	SV *self
	515	varspec_t variable
	516	PREINIT:
	517	HV *namespace;
	518	SV **entry;
	519	CODE:
	520	namespace = _get_namespace(self);
	521	entry = hv_fetch(namespace, variable.name, strlen(variable.name), 0);
	522	if (!entry)
	523	XSRETURN_EMPTY;
	524
	525	if (isGV(*entry)) {
	526	GV glob = (GV)(*entry);
	527	switch (variable.type) {
	528	case VAR_SCALAR:
4e3b237e	529	GvSV(glob) = (SV *)NULL;
215f49f8	530	break;
215f49f8	531	case VAR_ARRAY:
4e3b237e	532	GvAV(glob) = (AV *)NULL;
215f49f8	533	break;
215f49f8	534	case VAR_HASH:
4e3b237e	535	GvHV(glob) = (HV *)NULL;
215f49f8	536	break;
215f49f8	537	case VAR_CODE:
4e3b237e	538	GvCV(glob) = (CV *)NULL;
02b4c373	539	GvCVGEN(glob) = 0;
02b4c373	540	mro_method_changed_in(GvSTASH(glob));
215f49f8	541	break;
215f49f8	542	case VAR_IO:
4e3b237e	543	GvIOp(glob) = (IO *)NULL;
215f49f8	544	break;
	545	}
	546	}
	547	else {
	548	if (variable.type == VAR_CODE) {
	549	hv_delete(namespace, variable.name, strlen(variable.name), G_DISCARD);
	550	}
	551	}
	552
	553	void
15c104e2	554	list_all_symbols(self, vartype=VAR_NONE)
9b608466	555	SV *self
	556	vartype_t vartype
	557	PPCODE:
	558	if (vartype == VAR_NONE) {
	559	HV *namespace;
	560	HE *entry;
	561	int keys;
	562
	563	namespace = _get_namespace(self);
	564	keys = hv_iterinit(namespace);
	565	EXTEND(SP, keys);
ebcc8ba8	566	while ((entry = hv_iternext(namespace))) {
9b608466	567	mPUSHs(newSVhek(HeKEY_hek(entry)));
	568	}
	569	}
	570	else {
	571	HV *namespace;
9b608466	572	SV *val;
	573	char *key;
	574	int len;
	575
	576	namespace = _get_namespace(self);
	577	hv_iterinit(namespace);
ebcc8ba8	578	while ((val = hv_iternextsv(namespace, &key, &len))) {
9b608466	579	GV gv = (GV)val;
	580	if (isGV(gv)) {
	581	switch (vartype) {
	582	case VAR_SCALAR:
	583	if (GvSV(val))
	584	mXPUSHp(key, len);
	585	break;
	586	case VAR_ARRAY:
	587	if (GvAV(val))
	588	mXPUSHp(key, len);
	589	break;
	590	case VAR_HASH:
	591	if (GvHV(val))
	592	mXPUSHp(key, len);
	593	break;
	594	case VAR_CODE:
	595	if (GvCVu(val))
	596	mXPUSHp(key, len);
	597	break;
	598	case VAR_IO:
	599	if (GvIO(val))
	600	mXPUSHp(key, len);
	601	break;
	602	}
	603	}
	604	else if (vartype == VAR_CODE) {
	605	mXPUSHp(key, len);
	606	}
	607	}
	608	}