r28635 - in /trunk/libclass-mop-perl: MOP.xs debian/changelog

[bricas-guest at users.alioth.debian.org]

Author: bricas-guest
Date: Fri Dec 26 17:38:59 2008
New Revision: 28635

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=28635
Log:
New upstream release

Modified:
    trunk/libclass-mop-perl/MOP.xs
    trunk/libclass-mop-perl/debian/changelog

Modified: trunk/libclass-mop-perl/MOP.xs
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/MOP.xs?rev=28635&op=diff
==============================================================================
--- trunk/libclass-mop-perl/MOP.xs (original)
+++ trunk/libclass-mop-perl/MOP.xs Fri Dec 26 17:38:59 2008
@@ -14,23 +14,32 @@
 #define NEED_sv_2pv_nolen
 #include "ppport.h"
 
-SV *key_name;
-U32 hash_name;
-
-SV *key_package;
-U32 hash_package;
-
-SV *key_package_name;
-U32 hash_package_name;
-
-SV *key_body;
-U32 hash_body;
-
-SV *key_package_cache_flag;
-U32 hash_package_cache_flag;
-
-SV *key_methods;
-U32 hash_methods;
+#define DECLARE_KEY(name) SV *key_##name; U32 hash_##name;
+
+#define PREHASH_KEY_WITH_VALUE(name, value) do { \
+    key_##name = newSVpvs(value); \
+    PERL_HASH(hash_##name, value, sizeof(value) - 1); \
+} while (0)
+
+/* this is basically the same as the above macro, except that the value will be
+ * the stringified name. However, we can't just implement this in terms of
+ * PREHASH_KEY_WITH_VALUE as that'd cause macro expansion on the value of
+ * 'name' when it's being passed to the other macro. suggestions on how to make
+ * this more elegant would be much appreciated */
+
+#define PREHASH_KEY(name) do { \
+    key_##name = newSVpvs(#name); \
+    PERL_HASH(hash_##name, #name, sizeof(#name) - 1); \
+} while (0)
+
+DECLARE_KEY(name);
+DECLARE_KEY(package);
+DECLARE_KEY(package_name);
+DECLARE_KEY(body);
+DECLARE_KEY(package_cache_flag);
+DECLARE_KEY(methods);
+DECLARE_KEY(VERSION);
+DECLARE_KEY(ISA);
 
 SV *method_metaclass;
 SV *associated_metaclass;
@@ -304,19 +313,14 @@
 MODULE = Class::MOP   PACKAGE = Class::MOP
 
 BOOT:
-    key_name = newSVpvs("name");
-    key_body = newSVpvs("body");
-    key_package = newSVpvs("package");
-    key_package_name = newSVpvs("package_name");
-    key_package_cache_flag = newSVpvs("_package_cache_flag");
-    key_methods = newSVpvs("methods");
-
-    PERL_HASH(hash_name, "name", 4);
-    PERL_HASH(hash_body, "body", 4);
-    PERL_HASH(hash_package, "package", 7);
-    PERL_HASH(hash_package_name, "package_name", 12);
-    PERL_HASH(hash_package_cache_flag, "_package_cache_flag", 19);
-    PERL_HASH(hash_methods, "methods", 7);
+    PREHASH_KEY(name);
+    PREHASH_KEY(body);
+    PREHASH_KEY(package);
+    PREHASH_KEY(package_name);
+    PREHASH_KEY(methods);
+    PREHASH_KEY(ISA);
+    PREHASH_KEY(VERSION);
+    PREHASH_KEY_WITH_VALUE(package_cache_flag, "_package_cache_flag");
 
     method_metaclass     = newSVpvs("method_metaclass");
     wrap                 = newSVpvs("wrap");
@@ -339,8 +343,60 @@
             PUSHs(newSVpv(name, 0));
         }
 
+PROTOTYPES: DISABLE
+
+void
+is_class_loaded(klass=&PL_sv_undef)
+    SV *klass
+    PREINIT:
+        HV *stash;
+        char *key;
+        I32 keylen;
+        GV *gv;
+    PPCODE:
+        if (!SvPOK(klass) || !SvCUR(klass)) {
+            XSRETURN_NO;
+        }
+
+        stash = gv_stashsv(klass, 0);
+        if (!stash) {
+            XSRETURN_NO;
+        }
+
+        if (hv_exists_ent (stash, key_VERSION, hash_VERSION)) {
+            HE *version = hv_fetch_ent(stash, key_VERSION, 0, hash_VERSION);
+            if (version && HeVAL(version) && GvSV(HeVAL(version))) {
+                XSRETURN_YES;
+            }
+        }
+
+        if (hv_exists_ent (stash, key_ISA, hash_ISA)) {
+            HE *isa = hv_fetch_ent(stash, key_ISA, 0, hash_ISA);
+            if (isa && HeVAL(isa) && GvAV(HeVAL(isa))) {
+                XSRETURN_YES;
+            }
+        }
+
+        (void)hv_iterinit(stash);
+        while ((gv = (GV *)hv_iternextsv(stash, &key, &keylen))) {
+            if (keylen <= 0) {
+                continue;
+            }
+
+            if (key[keylen - 1] == ':' && key[keylen - 2] == ':') {
+                continue;
+            }
+
+            if (!isGV(gv) || GvCV(gv) || GvSV(gv) || GvAV(gv) || GvHV(gv) || GvIO(gv) || GvFORM(gv)) {
+                XSRETURN_YES;
+            }
+        }
+
+        XSRETURN_NO;
 
 MODULE = Class::MOP   PACKAGE = Class::MOP::Package
+
+PROTOTYPES: ENABLE
 
 void
 get_all_package_symbols(self, filter=TYPE_FILTER_NONE)

Modified: trunk/libclass-mop-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/debian/changelog?rev=28635&op=diff
==============================================================================
--- trunk/libclass-mop-perl/debian/changelog (original)
+++ trunk/libclass-mop-perl/debian/changelog Fri Dec 26 17:38:59 2008
@@ -1,3 +1,9 @@
+libclass-mop-perl (0.74-1) UNRELEASED; urgency=low
+
+  * New upstream release
+
+ -- Brian Cassidy <brian.cassidy at gmail.com>  Fri, 26 Dec 2008 13:38:28 -0400
+
 libclass-mop-perl (0.73-1) unstable; urgency=low
 
   * New upstream release.