[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;

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_package_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_package_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_package_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_package_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_package_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_package_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;
            break;
        case VAR_ARRAY:
            SvREFCNT_dec(GvAV(glob));
            GvAV(glob) = (AV*)val;
            break;
        case VAR_HASH:
            SvREFCNT_dec(GvHV(glob));
            GvHV(glob) = (HV*)val;
            break;
        case VAR_CODE:
            SvREFCNT_dec(GvCV(glob));
            GvCV(glob) = (CV*)val;
            break;
        case VAR_IO:
            SvREFCNT_dec(GvIO(glob));
            GvIOp(glob) = (IO*)val;
            break;
        }
    }

    SvREFCNT_dec(name);

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

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

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