Mouse.xs

   1 #define PERL_NO_GET_CONTEXT
   2 #include <EXTERN.h>
   3 #include <perl.h>
   4 #include <XSUB.h>
   5 #include "ppport.h"
   6
   7 MODULE = Mouse  PACKAGE = Mouse::Util
   8
   9 PROTOTYPES: DISABLE
  10
  11 BOOT:
  12         NOOP;
  13
  14 char *
  15 blessed(sv)
  16     SV * sv
  17 PROTOTYPE: $
  18 CODE:
  19 {
  20     if (SvMAGICAL(sv))
  21     mg_get(sv);
  22     if(!sv_isobject(sv)) {
  23         XSRETURN_UNDEF;
  24     }
  25     RETVAL = (char*)sv_reftype(SvRV(sv),TRUE);
  26 }
  27 OUTPUT:
  28     RETVAL
  29
  30 char *
  31 reftype(sv)
  32     SV * sv
  33 PROTOTYPE: $
  34 CODE:
  35 {
  36     if (SvMAGICAL(sv))
  37         mg_get(sv);
  38     if(!SvROK(sv)) {
  39         XSRETURN_UNDEF;
  40     }
  41     RETVAL = (char*)sv_reftype(SvRV(sv),FALSE);
  42 }
  43 OUTPUT:
  44     RETVAL
  45
  46 int
  47 looks_like_number(sv)
  48         SV *sv
  49 PROTOTYPE: $
  50 CODE:
  51 #if (PERL_VERSION < 8) || (PERL_VERSION == 8 && PERL_SUBVERSION <5)
  52   if (SvPOK(sv) || SvPOKp(sv)) {
  53     RETVAL = looks_like_number(sv);
  54   }
  55   else {
  56     RETVAL = SvFLAGS(sv) & (SVf_NOK|SVp_NOK|SVf_IOK|SVp_IOK);
  57   }
  58 #else
  59   RETVAL = looks_like_number(sv);
  60 #endif
  61 OUTPUT:
  62   RETVAL
  63
  64 void
  65 weaken(sv)
  66         SV *sv
  67 PROTOTYPE: $
  68 CODE:
  69 #ifdef SvWEAKREF
  70         sv_rvweaken(sv);
  71 #else
  72         croak("weak references are not implemented in this release of perl");
  73 #endif
  74