Stash.xs

   1 #include "EXTERN.h"
   2 #include "perl.h"
   3 #include "XSUB.h"
   4
   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
  22 vartype_t string_to_vartype(char *vartype)
  23 {
  24     if (strEQ(vartype, "SCALAR")) {
  25         return VAR_SCALAR;
  26     }
  27     else if (strEQ(vartype, "ARRAY")) {
  28         return VAR_ARRAY;
  29     }
  30     else if (strEQ(vartype, "HASH")) {
  31         return VAR_HASH;
  32     }
  33     else if (strEQ(vartype, "CODE")) {
  34         return VAR_CODE;
  35     }
  36     else if (strEQ(vartype, "IO")) {
  37         return VAR_IO;
  38     }
  39     else {
  40         croak("Type must be one of 'SCALAR', 'ARRAY', 'HASH', 'CODE', or 'IO'");
  41     }
  42 }
  43
  44 void _deconstruct_variable_name(char *variable, varspec_t *varspec)
  45 {
  46     if (!variable || !variable[0])
  47         croak("You must pass a variable name");
  48
  49     varspec->type = VAR_NONE;
  50
  51     switch (variable[0]) {
  52     case '$':
  53         varspec->type = VAR_SCALAR;
  54         break;
  55     case '@':
  56         varspec->type = VAR_ARRAY;
  57         break;
  58     case '%':
  59         varspec->type = VAR_HASH;
  60         break;
  61     case '&':
  62         varspec->type = VAR_CODE;
  63         break;
  64     }
  65
  66     if (varspec->type != VAR_NONE) {
  67         varspec->sigil = variable[0];
  68         varspec->name = &variable[1];
  69     }
  70     else {
  71         varspec->type = VAR_IO;
  72         varspec->sigil = '\0';
  73         varspec->name = variable;
  74     }
  75 }
  76
  77 void _deconstruct_variable_hash(HV *variable, varspec_t *varspec)
  78 {
  79     SV **val;
  80     char *type;
  81
  82     val = hv_fetch(variable, "name", 4, 0);
  83     if (!val)
  84         croak("The 'name' key is required in variable specs");
  85
  86     varspec->name = savesvpv(*val);
  87
  88     val = hv_fetch(variable, "sigil", 5, 0);
  89     if (!val)
  90         croak("The 'sigil' key is required in variable specs");
  91
  92     varspec->sigil = (SvPV_nolen(*val))[0];
  93
  94     val = hv_fetch(variable, "type", 4, 0);
  95     if (!val)
  96         croak("The 'type' key is required in variable specs");
  97
  98     varspec->type = string_to_vartype(SvPV_nolen(*val));
  99 }
 100
 101 int _valid_for_type(SV *value, vartype_t type)
 102 {
 103     svtype sv_type = SvROK(value) ? SvTYPE(SvRV(value)) : SVt_NULL;
 104
 105     switch (type) {
 106     case VAR_SCALAR:
 107         return sv_type == SVt_NULL ||
 108                sv_type == SVt_IV   ||
 109                sv_type == SVt_NV   ||
 110                sv_type == SVt_PV   ||
 111                sv_type == SVt_RV;
 112     case VAR_ARRAY:
 113         return sv_type == SVt_PVAV;
 114     case VAR_HASH:
 115         return sv_type == SVt_PVHV;
 116     case VAR_CODE:
 117         return sv_type == SVt_PVCV;
 118     case VAR_IO:
 119         return sv_type == SVt_PVGV;
 120     default:
 121         return 0;
 122     }
 123 }
 124
 125 HV *_get_namespace(SV *self)
 126 {
 127     dSP;
 128     SV *ret;
 129
 130     PUSHMARK(SP);
 131     XPUSHs(self);
 132     PUTBACK;
 133
 134     call_method("namespace", G_SCALAR);
 135
 136     SPAGAIN;
 137     ret = POPs;
 138     PUTBACK;
 139
 140     return (HV*)SvRV(ret);
 141 }
 142
 143 MODULE = Package::Stash  PACKAGE = Package::Stash
 144
 145 PROTOTYPES: DISABLE
 146
 147 SV*
 148 new(class, package_name)
 149     char *class
 150     SV *package_name
 151   PREINIT:
 152     HV *instance;
 153     HV *namespace;
 154   CODE:
 155     if (!SvPOK(package_name))
 156         croak("The constructor argument must be the name of a package");
 157
 158     instance = newHV();
 159
 160     hv_store(instance, "name", 4, package_name, 0);
 161     namespace = gv_stashpv(SvPV_nolen(package_name), GV_ADD);
 162     hv_store(instance, "namespace", 9, newRV((SV*)namespace), 0);
 163
 164     RETVAL = sv_bless(newRV((SV*)instance), gv_stashpv(class, 0));
 165   OUTPUT:
 166     RETVAL
 167
 168 SV*
 169 name(self)
 170     SV *self
 171   PREINIT:
 172     SV **slot;
 173   CODE:
 174     if (!sv_isobject(self))
 175         croak("Can't call name as a class method");
 176     slot = hv_fetch((HV*)SvRV(self), "name", 4, 0);
 177     RETVAL = slot ? SvREFCNT_inc(*slot) : &PL_sv_undef;
 178   OUTPUT:
 179     RETVAL
 180
 181 SV*
 182 namespace(self)
 183     SV *self
 184   PREINIT:
 185     SV **slot;
 186   CODE:
 187     if (!sv_isobject(self))
 188         croak("Can't call namespace as a class method");
 189     slot = hv_fetch((HV*)SvRV(self), "namespace", 9, 0);
 190     RETVAL = slot ? SvREFCNT_inc(*slot) : &PL_sv_undef;
 191   OUTPUT:
 192     RETVAL
 193
 194 void
 195 remove_package_glob(self, name)
 196     SV *self
 197     char *name
 198   CODE:
 199     hv_delete(_get_namespace(self), name, strlen(name), G_DISCARD);
 200
 201 void
 202 remove_package_symbol(self, variable)
 203     SV *self
 204     varspec_t variable
 205   PREINIT:
 206     HV *namespace;
 207     SV **entry;
 208   CODE:
 209     namespace = _get_namespace(self);
 210     entry = hv_fetch(namespace, variable.name, strlen(variable.name), 0);
 211     if (!entry)
 212         XSRETURN_EMPTY;
 213
 214     if (isGV(*entry)) {
 215         GV *glob = (GV*)(*entry);
 216         switch (variable.type) {
 217         case VAR_SCALAR:
 218             GvSV(glob) = Nullsv;
 219             break;
 220         case VAR_ARRAY:
 221             GvAV(glob) = Nullav;
 222             break;
 223         case VAR_HASH:
 224             GvHV(glob) = Nullhv;
 225             break;
 226         case VAR_CODE:
 227             GvCV(glob) = Nullcv;
 228             break;
 229         case VAR_IO:
 230             GvIOp(glob) = Null(struct io*);
 231             break;
 232         }
 233     }
 234     else {
 235         if (variable.type == VAR_CODE) {
 236             hv_delete(namespace, variable.name, strlen(variable.name), G_DISCARD);
 237         }
 238     }
 239
 240 void
 241 list_all_package_symbols(self, vartype=VAR_NONE)
 242     SV *self
 243     vartype_t vartype
 244   PPCODE:
 245     if (vartype == VAR_NONE) {
 246         HV *namespace;
 247         HE *entry;
 248         int keys;
 249
 250         namespace = _get_namespace(self);
 251         keys = hv_iterinit(namespace);
 252         EXTEND(SP, keys);
 253         while (entry = hv_iternext(namespace)) {
 254             mPUSHs(newSVhek(HeKEY_hek(entry)));
 255         }
 256     }
 257     else {
 258         HV *namespace;
 259         HE *entry;
 260         SV *val;
 261         char *key;
 262         int len;
 263
 264         namespace = _get_namespace(self);
 265         hv_iterinit(namespace);
 266         while (val = hv_iternextsv(namespace, &key, &len)) {
 267             GV *gv = (GV*)val;
 268             if (isGV(gv)) {
 269                 switch (vartype) {
 270                 case VAR_SCALAR:
 271                     if (GvSV(val))
 272                         mXPUSHp(key, len);
 273                     break;
 274                 case VAR_ARRAY:
 275                     if (GvAV(val))
 276                         mXPUSHp(key, len);
 277                     break;
 278                 case VAR_HASH:
 279                     if (GvHV(val))
 280                         mXPUSHp(key, len);
 281                     break;
 282                 case VAR_CODE:
 283                     if (GvCVu(val))
 284                         mXPUSHp(key, len);
 285                     break;
 286                 case VAR_IO:
 287                     if (GvIO(val))
 288                         mXPUSHp(key, len);
 289                     break;
 290                 }
 291             }
 292             else if (vartype == VAR_CODE) {
 293                 mXPUSHp(key, len);
 294             }
 295         }
 296     }