+#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
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
projects / gitmo/Class-MOP.git / commitdiff