xs/Package.xs

   1 #define NEED_newSVpvn_flags
   2 #include "mop.h"
   3
   4 static SV*
   5 mop_deconstruct_variable_name(pTHX_ SV* const variable, svtype* const type, const char** const type_name) {
   6         SV* name;
   7
   8         if(SvROK(variable) && SvTYPE(SvRV(variable)) == SVt_PVHV){
   9                 /* e.g. variable = { type => "SCALAR", name => "foo" } */
  10                 HV* const hv = (HV*)SvRV(variable);
  11                 SV** svp;
  12                 STRLEN len;
  13                 const char* pv;
  14
  15                 svp = hv_fetchs(hv, "name", FALSE);
  16                 if(!(svp && SvOK(*svp))){
  17                         croak("You must pass a variable name");
  18                 }
  19                 name = *svp;
  20                 pv   = SvPV_const(name, len);
  21                 if(len < 1){
  22                         croak("You must pass a variable name");
  23                 }
  24
  25                 svp = hv_fetchs(hv, "type", FALSE);
  26                 if(!(svp && SvOK(*svp))) {
  27                         croak("You must pass a variable type");
  28                 }
  29                 pv = SvPV_nolen_const(*svp);
  30                 if(strEQ(pv, "SCALAR")){
  31                         *type = SVt_PV; /* for all the type of scalars */
  32                 }
  33                 else if(strEQ(pv, "ARRAY")){
  34                         *type = SVt_PVAV;
  35                 }
  36                 else if(strEQ(pv, "HASH")){
  37                         *type = SVt_PVHV;
  38                 }
  39                 else if(strEQ(pv, "CODE")){
  40                         *type = SVt_PVCV;
  41                 }
  42                 else if(strEQ(pv, "GLOB")){
  43                         *type = SVt_PVGV;
  44                 }
  45                 else if(strEQ(pv, "IO")){
  46                         *type = SVt_PVIO;
  47                 }
  48                 else{
  49                         croak("I do not recognize that type '%s'", pv);
  50                 }
  51                 *type_name = pv;
  52         }
  53         else {
  54                 STRLEN len;
  55                 const char* pv;
  56                 /* e.g. variable = '$foo' */
  57                 if(!SvOK(variable)) {
  58                         croak("You must pass a variable name");
  59                 }
  60                 pv = SvPV_const(variable, len);
  61                 if(len < 2){
  62                         croak("You must pass a variable name including a sigil");
  63                 }
  64
  65                 switch(pv[0]){
  66                 case '$':
  67                         *type      = SVt_PV; /* for all the types of scalars */
  68                         *type_name = "SCALAR";
  69                         break;
  70                 case '@':
  71                         *type      = SVt_PVAV;
  72                         *type_name = "ARRAY";
  73                         break;
  74                 case '%':
  75                         *type      = SVt_PVHV;
  76                         *type_name = "HASH";
  77                         break;
  78                 case '&':
  79                         *type      = SVt_PVCV;
  80                         *type_name = "CODE";
  81                         break;
  82                 case '*':
  83                         *type      = SVt_PVGV;
  84                         *type_name = "GLOB";
  85                         break;
  86                 default:
  87                         croak("I do not recognize that sigil '%c'", pv[0]);
  88                 }
  89
  90                 name = newSVpvn_share(pv+1, len-1, 0U);
  91                 sv_2mortal(name);
  92         }
  93
  94         return name;
  95 }
  96
  97 MODULE = Class::MOP::Package   PACKAGE = Class::MOP::Package
  98
  99 PROTOTYPES: DISABLE
 100
 101 void
 102 get_all_package_symbols(self, filter=TYPE_FILTER_NONE)
 103     SV *self
 104     type_filter_t filter
 105     PREINIT:
 106         HV *stash = NULL;
 107         HV *symbols = NULL;
 108         register HE *he;
 109     PPCODE:
 110         if ( ! SvROK(self) ) {
 111             die("Cannot call get_all_package_symbols as a class method");
 112         }
 113
 114         if (GIMME_V == G_VOID) {
 115             XSRETURN_EMPTY;
 116         }
 117
 118         PUTBACK;
 119
 120         if ( (he = hv_fetch_ent((HV *)SvRV(self), KEY_FOR(package), 0, HASH_FOR(package))) ) {
 121             stash = gv_stashsv(HeVAL(he), 0);
 122         }
 123
 124
 125         if (!stash) {
 126             XSRETURN_UNDEF;
 127         }
 128
 129         symbols = mop_get_all_package_symbols(stash, filter);
 130         PUSHs(sv_2mortal(newRV_noinc((SV *)symbols)));
 131
 132 BOOT:
 133     INSTALL_SIMPLE_READER_WITH_KEY(Package, name, package);
 134
 135 SV*
 136 add_package_symbol(SV* self, SV* variable, SV* ref = &PL_sv_undef)
 137 PREINIT:
 138         svtype type;
 139         const char* type_name;
 140         SV* var_name;
 141         SV* package_name;
 142         SV* fq_name;
 143 CODE:
 144         var_name = mop_deconstruct_variable_name(aTHX_ variable, &type, &type_name);
 145
 146         package_name = mop_call0(aTHX_ self, KEY_FOR(name));
 147         if(!SvOK(package_name)){
 148                 croak("name() did not return a defined value");
 149         }
 150         fq_name = newSVpvf("%"SVf"::%"SVf, package_name, var_name);
 151         sv_2mortal(fq_name);
 152
 153         if(SvOK(ref)){ /* set */
 154                 GV* gv;
 155                 if(type == SVt_PV){
 156                         if(!SvROK(ref)){
 157                                 ref = newRV_noinc(newSVsv(ref));
 158                                 sv_2mortal(ref);
 159                         }
 160                 }
 161                 else if(!(SvROK(ref) && SvTYPE(SvRV(ref)) == type)){
 162                         croak("You must pass a reference of %s for the value of %s", type_name, GvNAME(CvGV(cv)));
 163                 }
 164                 gv = gv_fetchsv(fq_name, GV_ADDMULTI, type);
 165
 166                 if(type == SVt_PVCV && GvCV(gv)){
 167                         /* XXX: should introduce an option { redefine => 1 } ? */
 168                         SvREFCNT_dec(GvCV(gv));
 169                         GvCV(gv) = NULL;
 170                 }
 171                 sv_setsv_mg((SV*)gv, ref); /* *glob = $ref */
 172                 RETVAL = ref;
 173         }
 174         else { /* init */
 175                 GV* const gv = gv_fetchsv(fq_name, GV_ADDMULTI, type);
 176                 SV* sv;
 177
 178                 switch(type){
 179                 case SVt_PV:
 180                         sv = GvSVn(gv);
 181                         break;
 182                 case SVt_PVAV:
 183                         sv = (SV*)GvAVn(gv);
 184                         break;
 185                 case SVt_PVHV:
 186                         sv = (SV*)GvHVn(gv);
 187                         break;
 188                 case SVt_PVCV:
 189                         sv = (SV*)GvCV(gv);
 190                         break;
 191                 case SVt_PVGV:
 192                         sv = (SV*)gv;
 193                         break;
 194                 case SVt_PVIO:
 195                         sv = (SV*)GvIOn(gv);
 196                         break;
 197                 default:
 198                         croak("NOT REACHED");
 199                         sv = NULL; /* -W */
 200                         break;
 201                 }
 202
 203                 if(sv){
 204                         RETVAL = sv_2mortal(newRV_inc(sv));
 205                 }
 206                 else{
 207                         RETVAL = &PL_sv_undef;
 208                 }
 209         }
 210         ST(0) = RETVAL;
 211
 212 SV*
 213 get_package_symbol(SV* self, SV* variable)
 214 ALIAS:
 215         get_package_symbol = GV_ADDMULTI
 216         has_package_symbol = 0
 217 PREINIT:
 218         svtype type;
 219         const char* type_name;
 220         SV* var_name;
 221         SV* package_name;
 222         SV* fq_name;
 223         GV* gv;
 224         SV* sv;
 225 CODE:
 226         var_name = mop_deconstruct_variable_name(aTHX_ variable, &type, &type_name);
 227
 228         package_name = mop_call0(aTHX_ self, KEY_FOR(name));
 229         if(!SvOK(package_name)){
 230                 croak("name() did not return a defined value");
 231         }
 232         fq_name = newSVpvf("%"SVf"::%"SVf, package_name, var_name);
 233         sv_2mortal(fq_name);
 234
 235         gv = gv_fetchsv(fq_name, ix, type);
 236         if(!gv){ /* no symbol in has_package_symbol() */
 237                 XSRETURN_NO;
 238         }
 239
 240         switch(type){
 241         case SVt_PV:
 242                 sv = GvSV(gv);
 243                 break;
 244         case SVt_PVAV:
 245                 sv = (SV*)GvAV(gv);
 246                 break;
 247         case SVt_PVHV:
 248                 sv = (SV*)GvHV(gv);
 249                 break;
 250         case SVt_PVCV:
 251                 sv = (SV*)GvCV(gv);
 252                 break;
 253         case SVt_PVGV:
 254                 sv = (SV*)gv;
 255                 break;
 256         case SVt_PVIO:
 257                 sv = (SV*)GvIO(gv);
 258                 break;
 259         default:
 260                 croak("NOT REACHED");
 261                 sv = NULL; /* -W */
 262                 break;
 263         }
 264
 265         if(!ix){ /* has_package_symbol */
 266                 RETVAL = boolSV(sv);
 267         }
 268         else{
 269                 if(sv){
 270                         RETVAL = newRV_inc(sv);
 271                 }
 272                 else{
 273                         RETVAL = &PL_sv_undef;
 274                 }
 275         }
 276 OUTPUT:
 277         RETVAL