Commit | Line | Data |
e0e4674a |
1 | |
2 | #include "EXTERN.h" |
3 | #include "perl.h" |
4 | #include "XSUB.h" |
b0e94057 |
5 | #include "ppport.h" |
e0e4674a |
6 | |
7 | /* |
e0e4674a |
8 | get_code_info: |
9 | Pass in a coderef, returns: |
10 | [ $pkg_name, $coderef_name ] ie: |
11 | [ 'Foo::Bar', 'new' ] |
12 | */ |
13 | |
14 | MODULE = Class::MOP PACKAGE = Class::MOP |
15 | |
d7bf3478 |
16 | PROTOTYPES: ENABLE |
17 | |
e0e4674a |
18 | void |
19 | get_code_info(coderef) |
20 | SV* coderef |
21 | PREINIT: |
22 | char* name; |
23 | char* pkg; |
24 | PPCODE: |
e0e4674a |
25 | if( SvOK(coderef) && SvROK(coderef) && SvTYPE(SvRV(coderef)) == SVt_PVCV){ |
26 | coderef = SvRV(coderef); |
7b62d87f |
27 | /* I think this only gets triggered with a mangled coderef, but if |
28 | we hit it without the guard, we segfault. The slightly odd return |
29 | value strikes me as an improvement (mst) |
30 | */ |
a4f4221a |
31 | #ifdef isGV_with_GP |
32 | if ( isGV_with_GP(CvGV(coderef))) { |
33 | #endif |
7b62d87f |
34 | pkg = HvNAME( GvSTASH(CvGV(coderef)) ); |
35 | name = GvNAME( CvGV(coderef) ); |
a4f4221a |
36 | #ifdef isGV_with_GP |
37 | } else { |
38 | pkg = "__UNKNOWN__"; |
39 | name = "__ANON__"; |
40 | } |
41 | #endif |
e0e4674a |
42 | |
43 | EXTEND(SP, 2); |
44 | PUSHs(newSVpvn(pkg, strlen(pkg))); |
45 | PUSHs(newSVpvn(name, strlen(name))); |
46 | } |
47 | |