From: gfx <gfuji@cpan.org>
Date: Mon, 26 Oct 2009 08:25:32 +0000 (+0900)
Subject: Add *.bs to MANIFEST.SKIP
X-Git-Tag: 0.40_01~6
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=commitdiff_plain;h=f028039da3965d19d1b971938f5e192dfaf5ace5

Add *.bs to MANIFEST.SKIP
---

diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP
index b0af657..ae788ea 100644
--- a/MANIFEST.SKIP
+++ b/MANIFEST.SKIP
@@ -55,3 +55,4 @@ Mouse-
 ppport\.h
 \.o(?:bj)?$
 \.c$
+\.bs$
diff --git a/mro_compat.h b/mro_compat.h
new file mode 100644
index 0000000..c5b5691
--- /dev/null
+++ b/mro_compat.h
@@ -0,0 +1,151 @@
+/*
+----------------------------------------------------------------------------
+
+    Devel::MRO/mro_compat.h - Provides mro functions for XS modules
+
+    Copyright (c) 2008-2009, Goro Fuji (gfx) <gfuji(at)cpan.org>.
+
+    This program is free software; you can redistribute it and/or
+    modify it under the same terms as Perl itself.
+
+----------------------------------------------------------------------------
+
+Usage:
+	#include "mro_compat.h"
+
+Functions:
+	AV*  mro_get_linear_isa(HV* stash)
+	UV   mro_get_pkg_gen(HV* stash)
+	void mro_method_changed_in(HV* stash)
+
+
+    See "perldoc Devel::MRO" for details.
+ */
+
+
+#ifdef mro_get_linear_isa /* >= 5.10.0 */
+
+/* NOTE:
+	Because ActivePerl 5.10.0 does not provide Perl_mro_meta_init(), 
+	which is used in HvMROMETA() macro, this mro_get_pkg_gen() refers
+	to xhv_mro_meta directly.
+*/
+/* compatible with &mro::get_pkg_gen() */
+#ifndef mro_get_pkg_gen
+#define mro_get_pkg_gen(stash) (HvAUX(stash) ? HvAUX(stash)->xhv_mro_meta->pkg_gen : (U32)0)
+#endif
+
+#ifndef mro_get_cache_gen
+#define mro_get_cache_gen(stash) (HvAUX(stash) ? HvAUX(stash)->xhv_mro_meta->cache_gen : (U32)0)
+#endif
+
+#ifndef mro_get_gen
+#define mro_get_gen(stash) (HvAUX(stash) ? (HvAUX(stash)->xhv_mro_meta->pkg_gen + HvAUX(stash)->xhv_mro_meta->cache_gen) : (U32)0)
+#endif
+
+#else /* < 5.10.0  */
+#define mro_get_linear_isa(stash) my_mro_get_linear_isa(aTHX_ stash)
+
+#define mro_method_changed_in(stash) ((void)stash, (void)PL_sub_generation++)
+#define mro_get_pkg_gen(stash)   ((void)stash, PL_sub_generation)
+#define mro_get_cache_gen(stash) ((void)stash, (U32)0)
+#define mro_get_gen(stash)       ((void)stash, PL_sub_generation)
+
+
+#if defined(NEED_mro_get_linear_isa) && !defined(NEED_mro_get_linear_isa_GLOBAL)
+static AV* my_mro_get_linear_isa(pTHX_ HV* const stash);
+static
+#else
+extern AV* my_mro_get_linear_isa(pTHX_ HV* const stash);
+#endif /* !NEED_mro_get_linear_isa */
+
+#if defined(NEED_mro_get_linear_isa) || defined(NEED_mro_get_linear_isa_GLOBAL)
+#define ISA_CACHE "::LINEALIZED_ISA_CACHE::"
+
+/* call &mro::get_linear_isa, which is actually &MRO::Compat::__get_linear_isa */
+AV*
+my_mro_get_linear_isa(pTHX_ HV* const stash){
+	GV* cachegv;
+	AV* isa;  /* linearized ISA cache */
+	SV* gen;  /* package generation */
+	CV* get_linear_isa;
+
+	assert(stash != NULL);
+	assert(SvTYPE(stash) == SVt_PVHV);
+
+	cachegv = *(GV**)hv_fetchs(stash, ISA_CACHE, TRUE);
+	if(!isGV(cachegv))
+		gv_init(cachegv, stash, ISA_CACHE, sizeof(ISA_CACHE)-1, GV_ADD);
+
+	isa = GvAVn(cachegv);
+#ifdef GvSVn
+	gen = GvSVn(cachegv);
+#else
+	gen = GvSV(cachegv);
+#endif
+
+	if(SvIOK(gen) && SvIVX(gen) == (IV)mro_get_pkg_gen(stash)){
+		return isa; /* returns the cache if available */
+	}
+	else{
+		SvREADONLY_off(isa);
+		av_clear(isa);
+	}
+
+	get_linear_isa = get_cv("mro::get_linear_isa", FALSE);
+	if(!get_linear_isa){
+		ENTER;
+		SAVETMPS;
+
+		Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, newSVpvs("MRO::Compat"), NULL, NULL);
+		get_linear_isa = get_cv("mro::get_linear_isa", TRUE);
+
+		FREETMPS;
+		LEAVE;
+	}
+
+	{
+		SV* avref;
+		dSP;
+
+		ENTER;
+		SAVETMPS;
+
+		PUSHMARK(SP);
+		mXPUSHp(HvNAME(stash), strlen(HvNAME(stash)));
+		PUTBACK;
+
+		call_sv((SV*)get_linear_isa, G_SCALAR);
+
+		SPAGAIN;
+		avref = POPs;
+		PUTBACK;
+
+		if(SvROK(avref) && SvTYPE(SvRV(avref)) == SVt_PVAV){
+			AV* const av  = (AV*)SvRV(avref);
+			I32 const len = AvFILLp(av) + 1;
+			I32 i;
+
+			for(i = 0; i < len; i++){
+				HV* const st = gv_stashsv(AvARRAY(av)[i], FALSE);
+				if(st)
+					av_push(isa, newSVpv(HvNAME(st), 0));
+			}
+			SvREADONLY_on(isa);
+		}
+		else{
+			Perl_croak(aTHX_ "panic: mro::get_linear_isa() didn't return an ARRAY reference");
+		}
+
+		FREETMPS;
+		LEAVE;
+	}
+
+	sv_setiv(gen, (IV)mro_get_pkg_gen(stash));
+	return isa;
+}
+#undef ISA_CACHE
+
+#endif /* !(defined(NEED_mro_get_linear_isa) || defined(NEED_mro_get_linear_isa_GLOBAL)) */
+
+#endif /* end of the file */