MOP.xs

   1
   2 #include "EXTERN.h"
   3 #include "perl.h"
   4 #include "XSUB.h"
   5 #include "ppport.h"
   6
   7 /*
   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
  16 PROTOTYPES: ENABLE
  17
  18 void
  19 get_code_info(coderef)
  20   SV* coderef
  21   PREINIT:
  22     char* name;
  23     char* pkg;
  24   PPCODE:
  25     if( SvOK(coderef) && SvROK(coderef) && SvTYPE(SvRV(coderef)) == SVt_PVCV){
  26       coderef = SvRV(coderef);
  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       */
  31 #ifdef isGV_with_GP
  32       if ( isGV_with_GP(CvGV(coderef))) {
  33 #endif
  34         pkg     = HvNAME( GvSTASH(CvGV(coderef)) );
  35         name    = GvNAME( CvGV(coderef) );
  36 #ifdef isGV_with_GP
  37       } else {
  38         pkg     = "__UNKNOWN__";
  39         name    = "__ANON__";
  40       }
  41 #endif
  42
  43       EXTEND(SP, 2);
  44       PUSHs(newSVpvn(pkg, strlen(pkg)));
  45       PUSHs(newSVpvn(name, strlen(name)));
  46     }
  47