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

diff --git a/Makefile.PL b/Makefile.PL
index 675b7fe..b08b726 100755 (executable)
--- 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 (file)
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
+