From: Tokuhiro Matsuno <tokuhirom@gp.ath.cx>
Date: Wed, 3 Dec 2008 07:33:50 +0000 (+0000)
Subject: (JUST A IDEA) copied from Scalar-List-Util/Util.xs
X-Git-Tag: 0.19~136^2~57
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=commitdiff_plain;h=654a7eeb5823f05629ffa124848de66c09eb18e3

(JUST A IDEA) copied from Scalar-List-Util/Util.xs
---

diff --git a/Makefile.PL b/Makefile.PL
index 675b7fe..b08b726 100755
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -9,5 +9,18 @@ build_requires 'Test::Exception';
 build_requires 'Sub::Uplevel';    # required by Test::Exception
 build_requires 'Test::More';
 
-WriteAll;
+auto_include;
 
+WriteMakefile(
+	OBJECT => '$(O_FILES)',
+	clean => {
+		FILES => q{
+			*.stackdump
+			*.gcov *.gcda *.gcno
+			*.out
+			nytprof
+			cover_db
+		},
+	},
+
+);
diff --git a/Mouse.xs b/Mouse.xs
new file mode 100644
index 0000000..70f51c1
--- /dev/null
+++ b/Mouse.xs
@@ -0,0 +1,74 @@
+#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
+