Stash.xs

   1 #include "EXTERN.h"
   2 #include "perl.h"
   3 #include "XSUB.h"
   4
   5 HV *_get_namespace(SV *self)
   6 {
   7     dSP;
   8     SV *ret;
   9
  10     PUSHMARK(SP);
  11     XPUSHs(self);
  12     PUTBACK;
  13
  14     call_method("namespace", G_SCALAR);
  15
  16     SPAGAIN;
  17     ret = POPs;
  18     PUTBACK;
  19
  20     return (HV*)SvRV(ret);
  21 }
  22
  23 MODULE = Package::Stash  PACKAGE = Package::Stash
  24
  25 PROTOTYPES: DISABLE
  26
  27 SV*
  28 new(class, package_name)
  29     char *class
  30     SV *package_name
  31   INIT:
  32     HV *instance;
  33     HV *namespace;
  34   CODE:
  35     if (!SvPOK(package_name))
  36         croak("The constructor argument must be the name of a package");
  37
  38     instance = newHV();
  39
  40     hv_store(instance, "name", 4, package_name, 0);
  41     namespace = gv_stashpv(SvPV_nolen(package_name), GV_ADD);
  42     hv_store(instance, "namespace", 9, newRV((SV*)namespace), 0);
  43
  44     RETVAL = sv_bless(newRV((SV*)instance), gv_stashpv(class, 0));
  45   OUTPUT:
  46     RETVAL
  47
  48 SV*
  49 name(self)
  50     SV *self
  51   INIT:
  52     SV **slot;
  53   CODE:
  54     if (!sv_isobject(self))
  55         croak("Can't call name as a class method");
  56     slot = hv_fetch((HV*)SvRV(self), "name", 4, 0);
  57     RETVAL = slot ? SvREFCNT_inc(*slot) : &PL_sv_undef;
  58   OUTPUT:
  59     RETVAL
  60
  61 SV*
  62 namespace(self)
  63     SV *self
  64   INIT:
  65     SV **slot;
  66   CODE:
  67     if (!sv_isobject(self))
  68         croak("Can't call namespace as a class method");
  69     slot = hv_fetch((HV*)SvRV(self), "namespace", 9, 0);
  70     RETVAL = slot ? SvREFCNT_inc(*slot) : &PL_sv_undef;
  71   OUTPUT:
  72     RETVAL
  73
  74 void
  75 remove_package_glob(self, name)
  76     SV *self
  77     char *name
  78   INIT:
  79     HV *namespace;
  80   CODE:
  81     hv_delete(_get_namespace(self), name, strlen(name), G_DISCARD);