allow passing anonymous stashes to the constructor
[gitmo/Package-Stash-XS.git] / XS.xs
diff --git a/XS.xs b/XS.xs
index 58c76b9..2021e6d 100644 (file)
--- a/XS.xs
+++ b/XS.xs
@@ -126,6 +126,7 @@ typedef struct {
 
 static U32 name_hash, namespace_hash, type_hash;
 static SV *name_key, *namespace_key, *type_key;
+static REGEXP *valid_module_regex;
 
 static const char *vartype_to_string(vartype_t type)
 {
@@ -185,6 +186,27 @@ static vartype_t string_to_vartype(char *vartype)
     }
 }
 
+static int _is_valid_module_name(SV *package)
+{
+    char *buf;
+    STRLEN len;
+    SV *sv;
+
+    buf = SvPV(package, len);
+
+    /* whee cargo cult */
+    sv = sv_newmortal();
+    sv_upgrade(sv, SVt_PV);
+    SvREADONLY_on(sv);
+    SvLEN(sv) = 0;
+    SvUTF8_on(sv);
+    SvPVX(sv) = buf;
+    SvCUR_set(sv, len);
+    SvPOK_on(sv);
+
+    return pregexec(valid_module_regex, buf, buf + len, buf, 1, sv, 1);
+}
+
 static void _deconstruct_variable_name(SV *variable, varspec_t *varspec)
 {
     char *varpv;
@@ -377,21 +399,35 @@ MODULE = Package::Stash::XS  PACKAGE = Package::Stash::XS
 PROTOTYPES: DISABLE
 
 SV*
-new(class, package_name)
+new(class, package)
     SV *class
-    SV *package_name
+    SV *package
   PREINIT:
     HV *instance;
   CODE:
-    if (!SvPOK(package_name))
-        croak("Package::Stash->new must be passed the name of the package to access");
+    if (SvPOK(package)) {
+        if (!_is_valid_module_name(package))
+            croak("%s is not a module name", SvPV_nolen(package));
 
-    instance = newHV();
+        instance = newHV();
 
-    if (!hv_store(instance, "name", 4, SvREFCNT_inc_simple_NN(package_name), 0)) {
-        SvREFCNT_dec(package_name);
-        SvREFCNT_dec(instance);
-        croak("Couldn't initialize the 'name' key, hv_store failed");
+        if (!hv_store(instance, "name", 4, SvREFCNT_inc_simple_NN(package), 0)) {
+            SvREFCNT_dec(package);
+            SvREFCNT_dec(instance);
+            croak("Couldn't initialize the 'name' key, hv_store failed");
+        }
+    }
+    else if (SvROK(package) && SvTYPE(SvRV(package)) == SVt_PVHV) {
+        instance = newHV();
+
+        if (!hv_store(instance, "namespace", 9, SvREFCNT_inc_simple_NN(package), 0)) {
+            SvREFCNT_dec(package);
+            SvREFCNT_dec(instance);
+            croak("Couldn't initialize the 'namespace' key, hv_store failed");
+        }
+    }
+    else {
+        croak("Package::Stash->new must be passed the name of the package to access");
     }
 
     RETVAL = sv_bless(newRV_noinc((SV*)instance), gv_stashsv(class, 0));
@@ -406,8 +442,12 @@ name(self)
   CODE:
     if (!sv_isobject(self))
         croak("Can't call name as a class method");
-    slot = hv_fetch_ent((HV*)SvRV(self), name_key, 0, name_hash);
-    RETVAL = slot ? SvREFCNT_inc_simple_NN(HeVAL(slot)) : &PL_sv_undef;
+    if (slot = hv_fetch_ent((HV*)SvRV(self), name_key, 0, name_hash)) {
+        RETVAL = SvREFCNT_inc_simple_NN(HeVAL(slot));
+    }
+    else {
+        croak("Can't get the name of an anonymous package");
+    }
   OUTPUT:
     RETVAL
 
@@ -779,6 +819,19 @@ get_all_symbols(self, vartype=VAR_NONE)
 
 BOOT:
     {
+        const char *vmre = "\\A[0-9A-Z_a-z]+(?:::[0-9A-Z_a-z]+)*\\z";
+#if (PERL_VERSION < 9) || ((PERL_VERSION == 9) && (PERL_SUBVERSION < 5))
+        PMOP fakepmop;
+
+        fakepmop.op_pmflags = 0;
+        valid_module_regex = pregcomp(vmre, vmre + strlen(vmre), &fakepmop);
+#else
+        SV *re;
+
+        re = newSVpv(vmre, 0);
+        valid_module_regex = pregcomp(re, 0);
+#endif
+
         name_key = newSVpvs("name");
         PERL_HASH(name_hash, "name", 4);