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 SV*
  26 new(class, package_name)
  27     char *class
  28     SV *package_name
  29   INIT:
  30     HV *instance;
  31     HV *namespace;
  32   CODE:
  33     if (!SvPOK(package_name))
  34         croak("The constructor argument must be the name of a package");
  35
  36     instance = newHV();
  37
  38     hv_store(instance, "name", 4, package_name, 0);
  39     namespace = gv_stashpv(SvPV_nolen(package_name), GV_ADD);
  40     hv_store(instance, "namespace", 9, newRV((SV*)namespace), 0);
  41
  42     RETVAL = sv_bless(newRV((SV*)instance), gv_stashpv(class, 0));
  43   OUTPUT:
  44     RETVAL
  45
  46 SV*
  47 name(self)
  48     SV *self
  49   INIT:
  50     SV **slot;
  51   CODE:
  52     if (!sv_isobject(self))
  53         croak("Can't call name as a class method");
  54     slot = hv_fetch((HV*)SvRV(self), "name", 4, 0);
  55     RETVAL = slot ? SvREFCNT_inc(*slot) : &PL_sv_undef;
  56   OUTPUT:
  57     RETVAL
  58
  59 SV*
  60 namespace(self)
  61     SV *self
  62   INIT:
  63     SV **slot;
  64   CODE:
  65     if (!sv_isobject(self))
  66         croak("Can't call namespace as a class method");
  67     slot = hv_fetch((HV*)SvRV(self), "namespace", 9, 0);
  68     RETVAL = slot ? SvREFCNT_inc(*slot) : &PL_sv_undef;
  69   OUTPUT:
  70     RETVAL
  71
  72 void
  73 remove_package_glob(self, name)
  74     SV *self
  75     char *name
  76   INIT:
  77     HV *namespace;
  78   CODE:
  79     hv_delete(_get_namespace(self), name, strlen(name), G_DISCARD);