develooper Front page | perl.perl5.porters | Postings from December 2008

[PATCH] Add mro_get_pkg_gen.

Thread Next
From:
Florian Ragwitz
Date:
December 14, 2008 06:02
Subject:
[PATCH] Add mro_get_pkg_gen.
Message ID:
1229161895-25042-1-git-send-email-rafl@debian.org
This provides a c interface for getting pkg_gen of a stash, similar to
the perl interface already provided with mro::get_pkg_gen($stash).

Without this patch, c code trying to get pkg_gen will need to directly
mess with the mro_meta structure, which isn't considered to be stable
yet.
---
 embed.fnc  |    1 +
 embed.h    |    2 ++
 global.sym |    1 +
 mro.c      |   32 ++++++++++++++++++++++++++++++++
 perlapi.c  |    4 +++-
 proto.h    |    5 +++++
 6 files changed, 44 insertions(+), 1 deletions(-)

diff --git a/embed.fnc b/embed.fnc
index c3835b3..7c36fe0 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1991,6 +1991,7 @@ XEMop	|void	|emulate_cop_io	|NN const COP *const c|NN SV *const sv
 XEMop	|REGEXP *|get_re_arg|NULLOK SV *sv
 
 p	|struct mro_meta*	|mro_meta_init	|NN HV* stash
+Apd	|U32			|mro_get_pkg_gen|NN HV* stash
 #if defined(USE_ITHREADS)
 p	|struct mro_meta*	|mro_meta_dup	|NN struct mro_meta* smeta|NN CLONE_PARAMS* param
 #endif
diff --git a/embed.h b/embed.h
index ace2037..6b97f29 100644
--- a/embed.h
+++ b/embed.h
@@ -1928,6 +1928,7 @@
 #ifdef PERL_CORE
 #define mro_meta_init		Perl_mro_meta_init
 #endif
+#define mro_get_pkg_gen		Perl_mro_get_pkg_gen
 #if defined(USE_ITHREADS)
 #ifdef PERL_CORE
 #define mro_meta_dup		Perl_mro_meta_dup
@@ -4260,6 +4261,7 @@
 #ifdef PERL_CORE
 #define mro_meta_init(a)	Perl_mro_meta_init(aTHX_ a)
 #endif
+#define mro_get_pkg_gen(a)	Perl_mro_get_pkg_gen(aTHX_ a)
 #if defined(USE_ITHREADS)
 #ifdef PERL_CORE
 #define mro_meta_dup(a,b)	Perl_mro_meta_dup(aTHX_ a,b)
diff --git a/global.sym b/global.sym
index 5e18194..a5cdaf9 100644
--- a/global.sym
+++ b/global.sym
@@ -767,6 +767,7 @@ Perl_my_strlcpy
 Perl_signbit
 Perl_emulate_cop_io
 Perl_get_re_arg
+Perl_mro_get_pkg_gen
 Perl_mro_get_linear_isa
 Perl_mro_method_changed_in
 Perl_sys_init
diff --git a/mro.c b/mro.c
index 6740d59..15b41bf 100644
--- a/mro.c
+++ b/mro.c
@@ -69,6 +69,38 @@ Perl_mro_meta_init(pTHX_ HV* stash)
     return newmeta;
 }
 
+/*
+=for apidoc mro_get_pkg_gen
+
+Returns an integer which is incremented every time a real local method in the
+package stash changes, or the local @ISA of the stash is modified.
+
+This is intended for authors of modules which do lots of class introspection,
+as it allows them to very quickly check if anything important about the local
+properties of a given class have changed since the last time they looked.  It
+does not increment on method/@ISA changes in superclasses.
+
+It's still up to you to seek out the actual changes, and there might not
+actually be any.  Perhaps all of the changes since you last checked cancelled
+each other out and left the package in the state it was in before.
+
+This integer normally starts off at a value of 1 when a package stash is
+instantiated.  Calling it on packages whose stashes do not exist at all will
+return 0.  If a package stash is completely deleted (not a normal occurence,
+but it can happen if someone does something like "undef %PkgName::"), the
+number will be reset to either 0 or 1, depending on how completely package was
+wiped out.
+
+=cut
+*/
+U32
+Perl_mro_get_pkg_gen(pTHX_ HV* stash)
+{
+    PERL_ARGS_ASSERT_MRO_GET_PKG_GEN;
+
+    return HvMROMETA(stash)->pkg_gen;
+}
+
 #if defined(USE_ITHREADS)
 
 /* for sv_dup on new threads */
diff --git a/perlapi.c b/perlapi.c
index d15afec..19b1b3e 100644
--- a/perlapi.c
+++ b/perlapi.c
@@ -18,7 +18,9 @@
  *
  * Up to the threshold of the door there mounted a flight of twenty-seven
  * broad stairs, hewn by some unknown art of the same black stone.  This
- * was the only entrance to the tower.
+ * was the only entrance to the tower; ...
+ *
+ *     [p.577 of _The Lord of the Rings_, III/x: "The Voice of Saruman"]
  *
  */
 
diff --git a/proto.h b/proto.h
index c466fba..3094fb5 100644
--- a/proto.h
+++ b/proto.h
@@ -6556,6 +6556,11 @@ PERL_CALLCONV struct mro_meta*	Perl_mro_meta_init(pTHX_ HV* stash)
 #define PERL_ARGS_ASSERT_MRO_META_INIT	\
 	assert(stash)
 
+PERL_CALLCONV U32	Perl_mro_get_pkg_gen(pTHX_ HV* stash)
+			__attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_MRO_GET_PKG_GEN	\
+	assert(stash)
+
 #if defined(USE_ITHREADS)
 PERL_CALLCONV struct mro_meta*	Perl_mro_meta_dup(pTHX_ struct mro_meta* smeta, CLONE_PARAMS* param)
 			__attribute__nonnull__(pTHX_1)
-- 
1.6.0.4


Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About