From: gfx Date: Thu, 16 Jul 2009 08:05:02 +0000 (+0900) Subject: Package symbol manipulators into XS X-Git-Tag: 0.92_01~34 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e170f134cf3887120c75f7416940ce0b01a48378;p=gitmo%2FClass-MOP.git Package symbol manipulators into XS TODO: pass all the test existing write new tests if needed --- diff --git a/lib/Class/MOP/Package.pm b/lib/Class/MOP/Package.pm index 358b39f..b4dce2c 100644 --- a/lib/Class/MOP/Package.pm +++ b/lib/Class/MOP/Package.pm @@ -130,6 +130,8 @@ sub namespace { # ... these functions have to touch the symbol table itself,.. yuk + + sub add_package_symbol { my ($self, $variable, $initial_value) = @_; diff --git a/xs/Package.xs b/xs/Package.xs index ce8d390..17838ed 100644 --- a/xs/Package.xs +++ b/xs/Package.xs @@ -1,5 +1,99 @@ +#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 @@ -37,3 +131,147 @@ get_all_package_symbols(self, filter=TYPE_FILTER_NONE) 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