Commit | Line | Data |
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 |
10 | SV *key_name; |
11 | U32 hash_name; |
12 | |
13 | SV *key_package; |
14 | U32 hash_package; |
15 | |
da88f307 |
16 | SV *key_package_name; |
17 | U32 hash_package_name; |
18 | |
cc856b56 |
19 | SV *key_body; |
20 | U32 hash_body; |
21 | |
e0e4674a |
22 | /* |
e0e4674a |
23 | get_code_info: |
24 | Pass in a coderef, returns: |
25 | [ $pkg_name, $coderef_name ] ie: |
26 | [ 'Foo::Bar', 'new' ] |
27 | */ |
28 | |
29 | MODULE = Class::MOP PACKAGE = Class::MOP |
30 | |
cc856b56 |
31 | BOOT: |
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 |
43 | PROTOTYPES: ENABLE |
44 | |
cc856b56 |
45 | |
e0e4674a |
46 | void |
47 | get_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 | |
77 | MODULE = Class::MOP PACKAGE = Class::MOP::Package |
78 | |
79 | void |
cc856b56 |
80 | get_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 | |
988fb42e |
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 | |
134 | /* we don't really care about the length, |
135 | but that's the API */ |
75705e60 |
136 | key = HePV(he, keylen); |
9457b596 |
137 | package = HvNAME(stash); |
fd27f6e9 |
138 | fq = newSVpvf("%s::%s", package, key); |
139 | sv = sv_2mortal((SV*)get_cv(SvPV_nolen(fq), 0)); |
15273f3c |
140 | break; |
141 | default: |
142 | continue; |
143 | } |
144 | |
145 | if ( sv ) { |
75705e60 |
146 | SV *key = hv_iterkeysv(he); |
15273f3c |
147 | SPAGAIN; |
148 | EXTEND(SP, 2); |
149 | PUSHs(key); |
66af67fe |
150 | PUSHs(sv_2mortal(newRV_inc(sv))); |
15273f3c |
151 | PUTBACK; |
152 | } |
153 | } |
154 | } else { |
155 | EXTEND(SP, HvKEYS(stash) * 2); |
156 | |
75705e60 |
157 | while ((he = hv_iternext(stash))) { |
158 | SV *key = hv_iterkeysv(he); |
599791aa |
159 | SV *sv = HeVAL(he); |
15273f3c |
160 | SPAGAIN; |
0eb2957d |
161 | PUSHs(key); |
15273f3c |
162 | PUSHs(sv); |
163 | PUTBACK; |
164 | } |
165 | } |
166 | |
167 | } |
168 | |
cc856b56 |
169 | SV * |
170 | name(self) |
171 | SV *self |
172 | PREINIT: |
173 | register HE *he; |
174 | PPCODE: |
988fb42e |
175 | if (! SvROK(self)) { |
176 | die("Cannot call name as a class method"); |
177 | } |
178 | |
179 | if (he = hv_fetch_ent((HV *)SvRV(self), key_package, 0, hash_package)) |
cc856b56 |
180 | XPUSHs(HeVAL(he)); |
181 | else |
182 | ST(0) = &PL_sv_undef; |
183 | |
dcbfe027 |
184 | MODULE = Class::MOP PACKAGE = Class::MOP::Attribute |
cc856b56 |
185 | |
186 | SV * |
187 | name(self) |
188 | SV *self |
189 | PREINIT: |
190 | register HE *he; |
191 | PPCODE: |
988fb42e |
192 | if (! SvROK(self)) { |
193 | die("Cannot call name as a class method"); |
194 | } |
195 | |
196 | if (he = hv_fetch_ent((HV *)SvRV(self), key_name, 0, hash_name)) |
cc856b56 |
197 | XPUSHs(HeVAL(he)); |
198 | else |
199 | ST(0) = &PL_sv_undef; |
200 | |
dcbfe027 |
201 | MODULE = Class::MOP PACKAGE = Class::MOP::Method |
cc856b56 |
202 | |
203 | SV * |
da88f307 |
204 | name(self) |
205 | SV *self |
206 | PREINIT: |
207 | register HE *he; |
208 | PPCODE: |
209 | if (! SvROK(self)) { |
210 | die("Cannot call name as a class method"); |
211 | } |
212 | |
213 | if (he = hv_fetch_ent((HV *)SvRV(self), key_name, 0, hash_name)) |
214 | XPUSHs(HeVAL(he)); |
215 | else |
216 | ST(0) = &PL_sv_undef; |
217 | |
218 | SV * |
219 | package_name(self) |
220 | SV *self |
221 | PREINIT: |
222 | register HE *he; |
223 | PPCODE: |
224 | if (! SvROK(self)) { |
225 | die("Cannot call package_name as a class method"); |
226 | } |
227 | |
228 | if (he = hv_fetch_ent((HV *)SvRV(self), key_package_name, 0, hash_package_name)) |
229 | XPUSHs(HeVAL(he)); |
230 | else |
231 | ST(0) = &PL_sv_undef; |
232 | |
233 | SV * |
cc856b56 |
234 | body(self) |
235 | SV *self |
236 | PREINIT: |
237 | register HE *he; |
238 | PPCODE: |
da88f307 |
239 | if (! SvROK(self)) { |
240 | die("Cannot call body as a class method"); |
241 | } |
242 | |
243 | if (he = hv_fetch_ent((HV *)SvRV(self), key_body, 0, hash_body)) |
cc856b56 |
244 | XPUSHs(HeVAL(he)); |
245 | else |
246 | ST(0) = &PL_sv_undef; |