[gitmo/Mouse.git] / Mouse.xs

#define PERL_NO_GET_CONTEXT
#include <EXTERN.h>
#include <perl.h>
#include <XSUB.h>
#include "ppport.h"

MODULE = Mouse  PACKAGE = Mouse::Util

PROTOTYPES: DISABLE

BOOT:
	NOOP;

char *
blessed(sv)
    SV * sv
PROTOTYPE: $
CODE:
{
    if (SvMAGICAL(sv))
    mg_get(sv);
    if(!sv_isobject(sv)) {
        XSRETURN_UNDEF;
    }
    RETVAL = (char*)sv_reftype(SvRV(sv),TRUE);
}
OUTPUT:
    RETVAL

char *
reftype(sv)
    SV * sv
PROTOTYPE: $
CODE:
{
    if (SvMAGICAL(sv))
	mg_get(sv);
    if(!SvROK(sv)) {
	XSRETURN_UNDEF;
    }
    RETVAL = (char*)sv_reftype(SvRV(sv),FALSE);
}
OUTPUT:
    RETVAL

int
looks_like_number(sv)
	SV *sv
PROTOTYPE: $
CODE:
#if (PERL_VERSION < 8) || (PERL_VERSION == 8 && PERL_SUBVERSION <5)
  if (SvPOK(sv) || SvPOKp(sv)) {
    RETVAL = looks_like_number(sv);
  }
  else {
    RETVAL = SvFLAGS(sv) & (SVf_NOK|SVp_NOK|SVf_IOK|SVp_IOK);
  }
#else
  RETVAL = looks_like_number(sv);
#endif
OUTPUT:
  RETVAL

void
weaken(sv)
	SV *sv
PROTOTYPE: $
CODE:
#ifdef SvWEAKREF
	sv_rvweaken(sv);
#else
	croak("weak references are not implemented in this release of perl");
#endif
Commit	Line	Data
654a7eeb	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