Avoid calling $self->metaclass->meta again and again
[gitmo/Class-MOP.git] / MOP.xs
CommitLineData
e0e4674a 1
2#include "EXTERN.h"
3#include "perl.h"
4#include "XSUB.h"
15273f3c 5
599791aa 6#define NEED_sv_2pv_flags
15273f3c 7#define NEED_sv_2pv_nolen
b0e94057 8#include "ppport.h"
e0e4674a 9
cc856b56 10SV *key_name;
11U32 hash_name;
12
13SV *key_package;
14U32 hash_package;
15
da88f307 16SV *key_package_name;
17U32 hash_package_name;
18
cc856b56 19SV *key_body;
20U32 hash_body;
21
e0e4674a 22/*
e0e4674a 23get_code_info:
24 Pass in a coderef, returns:
25 [ $pkg_name, $coderef_name ] ie:
26 [ 'Foo::Bar', 'new' ]
27*/
28
29MODULE = Class::MOP PACKAGE = Class::MOP
30
cc856b56 31BOOT:
32 key_name = newSVpvs("name");
33 key_body = newSVpvs("body");
34 key_package = newSVpvs("package");
da88f307 35 key_package_name = newSVpvs("package_name");
cc856b56 36
37 PERL_HASH(hash_name, "name", 4);
38 PERL_HASH(hash_body, "body", 4);
39 PERL_HASH(hash_package, "package", 7);
da88f307 40 PERL_HASH(hash_package_name, "package_name", 12);
cc856b56 41
42
d7bf3478 43PROTOTYPES: ENABLE
44
cc856b56 45
e0e4674a 46void
47get_code_info(coderef)
48 SV* coderef
49 PREINIT:
50 char* name;
51 char* pkg;
52 PPCODE:
e0e4674a 53 if( SvOK(coderef) && SvROK(coderef) && SvTYPE(SvRV(coderef)) == SVt_PVCV){
54 coderef = SvRV(coderef);
7b62d87f 55 /* I think this only gets triggered with a mangled coderef, but if
56 we hit it without the guard, we segfault. The slightly odd return
57 value strikes me as an improvement (mst)
58 */
a4f4221a 59#ifdef isGV_with_GP
60 if ( isGV_with_GP(CvGV(coderef))) {
61#endif
7b62d87f 62 pkg = HvNAME( GvSTASH(CvGV(coderef)) );
63 name = GvNAME( CvGV(coderef) );
a4f4221a 64#ifdef isGV_with_GP
65 } else {
66 pkg = "__UNKNOWN__";
67 name = "__ANON__";
68 }
69#endif
e0e4674a 70
71 EXTEND(SP, 2);
72 PUSHs(newSVpvn(pkg, strlen(pkg)));
73 PUSHs(newSVpvn(name, strlen(name)));
74 }
75
15273f3c 76
77MODULE = Class::MOP PACKAGE = Class::MOP::Package
78
79void
cc856b56 80get_all_package_symbols(self, ...)
81 SV *self
15273f3c 82 PROTOTYPE: $;$
83 PREINIT:
cc856b56 84 HV *stash = NULL;
15273f3c 85 SV *type_filter = NULL;
75705e60 86 register HE *he;
15273f3c 87 PPCODE:
988fb42e 88 if (! SvROK(self)) {
89 die("Cannot call get_all_package_symbols as a class method");
90 }
15273f3c 91
92 switch ( GIMME_V ) {
93 case G_VOID: return; break;
94 case G_SCALAR: ST(0) = &PL_sv_undef; return; break;
95 }
96
97 if ( items > 1 ) type_filter = ST(1);
98
99 PUTBACK;
100
c50e7c47 101 if ((he = hv_fetch_ent((HV *)SvRV(self), key_package, 0, hash_package)))
75705e60 102 stash = gv_stashsv(HeVAL(he),0);
15273f3c 103
104 if ( stash ) {
15273f3c 105
106 (void)hv_iterinit(stash);
107
108 if ( type_filter && SvPOK(type_filter) ) {
109 const char *const type = SvPV_nolen(type_filter);
110
75705e60 111 while ((he = hv_iternext(stash))) {
112 SV *const gv = HeVAL(he);
15273f3c 113 SV *sv;
75705e60 114 char *key;
115 STRLEN keylen;
9457b596 116 char *package;
fd27f6e9 117 SV *fq;
15273f3c 118
15273f3c 119 switch( SvTYPE(gv) ) {
120 case SVt_PVGV:
121 switch (*type) {
122 case 'C': sv = (SV *)GvCVu(gv); break; /* CODE */
123 case 'A': sv = (SV *)GvAV(gv); break; /* ARRAY */
124 case 'I': sv = (SV *)GvIO(gv); break; /* IO */
125 case 'H': sv = (SV *)GvHV(gv); break; /* HASH */
126 case 'S': sv = (SV *)GvSV(gv); break; /* SCALAR */
127 default:
128 croak("Unknown type %s\n", type);
129 }
130 break;
131 case SVt_RV:
132 /* BAH! constants are horrible */
fd27f6e9 133
fd8c46e5 134 if (!SvROK (gv)) {
135 continue;
136 }
137
fd27f6e9 138 /* we don't really care about the length,
139 but that's the API */
75705e60 140 key = HePV(he, keylen);
9457b596 141 package = HvNAME(stash);
fd27f6e9 142 fq = newSVpvf("%s::%s", package, key);
8babf00a 143 sv = (SV*)get_cv(SvPV_nolen(fq), 0);
15273f3c 144 break;
145 default:
146 continue;
147 }
148
149 if ( sv ) {
75705e60 150 SV *key = hv_iterkeysv(he);
15273f3c 151 SPAGAIN;
152 EXTEND(SP, 2);
153 PUSHs(key);
66af67fe 154 PUSHs(sv_2mortal(newRV_inc(sv)));
15273f3c 155 PUTBACK;
156 }
157 }
158 } else {
159 EXTEND(SP, HvKEYS(stash) * 2);
160
75705e60 161 while ((he = hv_iternext(stash))) {
162 SV *key = hv_iterkeysv(he);
599791aa 163 SV *sv = HeVAL(he);
15273f3c 164 SPAGAIN;
0eb2957d 165 PUSHs(key);
15273f3c 166 PUSHs(sv);
167 PUTBACK;
168 }
169 }
170
171 }
172
e2c189ae 173void
cc856b56 174name(self)
175 SV *self
176 PREINIT:
177 register HE *he;
178 PPCODE:
988fb42e 179 if (! SvROK(self)) {
180 die("Cannot call name as a class method");
181 }
182
c50e7c47 183 if ((he = hv_fetch_ent((HV *)SvRV(self), key_package, 0, hash_package)))
cc856b56 184 XPUSHs(HeVAL(he));
185 else
186 ST(0) = &PL_sv_undef;
187
dcbfe027 188MODULE = Class::MOP PACKAGE = Class::MOP::Attribute
cc856b56 189
e2c189ae 190void
cc856b56 191name(self)
192 SV *self
193 PREINIT:
194 register HE *he;
195 PPCODE:
988fb42e 196 if (! SvROK(self)) {
197 die("Cannot call name as a class method");
198 }
199
c50e7c47 200 if ((he = hv_fetch_ent((HV *)SvRV(self), key_name, 0, hash_name)))
cc856b56 201 XPUSHs(HeVAL(he));
202 else
203 ST(0) = &PL_sv_undef;
204
dcbfe027 205MODULE = Class::MOP PACKAGE = Class::MOP::Method
cc856b56 206
e2c189ae 207void
da88f307 208name(self)
209 SV *self
210 PREINIT:
211 register HE *he;
212 PPCODE:
213 if (! SvROK(self)) {
214 die("Cannot call name as a class method");
215 }
216
c50e7c47 217 if ((he = hv_fetch_ent((HV *)SvRV(self), key_name, 0, hash_name)))
da88f307 218 XPUSHs(HeVAL(he));
219 else
220 ST(0) = &PL_sv_undef;
221
e2c189ae 222void
da88f307 223package_name(self)
224 SV *self
225 PREINIT:
226 register HE *he;
227 PPCODE:
228 if (! SvROK(self)) {
229 die("Cannot call package_name as a class method");
230 }
231
c50e7c47 232 if ((he = hv_fetch_ent((HV *)SvRV(self), key_package_name, 0, hash_package_name)))
da88f307 233 XPUSHs(HeVAL(he));
234 else
235 ST(0) = &PL_sv_undef;
236
e2c189ae 237void
cc856b56 238body(self)
239 SV *self
240 PREINIT:
241 register HE *he;
242 PPCODE:
da88f307 243 if (! SvROK(self)) {
244 die("Cannot call body as a class method");
245 }
246
c50e7c47 247 if ((he = hv_fetch_ent((HV *)SvRV(self), key_body, 0, hash_body)))
cc856b56 248 XPUSHs(HeVAL(he));
249 else
250 ST(0) = &PL_sv_undef;