vovkasm · basiliscos · Jul 1, 2020 · Jul 3, 2020 · Jul 7, 2020 · Jul 7, 2020
diff --git a/Makefile.PL b/Makefile.PL
@@ -33,8 +33,8 @@ WriteMakefile(
     LICENSE         => 'perl',
     MIN_PERL_VERSION=> 5.010001,
     CCFLAGS         => $CCFLAGS,
+    OBJECT           => 'XS.o meta.o',
     #LIBS            => ['-lstdc++'],
-    #XSOPT           => '-C++',
 );
 
 {

diff --git a/XS.xs b/XS.xs
@@ -10,54 +10,60 @@ static MGVTBL sv_payload_marker;
 static bool optimize_entersub = 1;
 static int unstolen = 0;
 
+#include "xs/meta.h"
 #include "xs/compat.h"
 #include "xs/types.h"
 #include "xs/accessors.h"
 #include "xs/installer.h"
 
 static void
 CAIXS_install_inherited_accessor(pTHX_ SV* full_name, SV* hash_key, SV* pkg_key, SV* read_cb, SV* write_cb, int opts) {
-    shared_keys* payload;
+    install_info info;
     bool need_cb = read_cb && write_cb;
 
     if (need_cb) {
         assert(pkg_key != NULL);
 
         if (opts & IsNamed) {
-            payload = CAIXS_install_accessor<InheritedCbNamed>(aTHX_ full_name, (AccessorOpts)(opts & ~IsNamed));
+            info = CAIXS_install_accessor<InheritedCbNamed>(aTHX_ full_name, (AccessorOpts)(opts & ~IsNamed));
         } else {
-            payload = CAIXS_install_accessor<InheritedCb>(aTHX_ full_name, (AccessorOpts)opts);
+            info = CAIXS_install_accessor<InheritedCb>(aTHX_ full_name, (AccessorOpts)opts);
         }
 
     } else if (pkg_key != NULL) {
-        payload = CAIXS_install_accessor<Inherited>(aTHX_ full_name, (AccessorOpts)opts);
+        info = CAIXS_install_accessor<Inherited>(aTHX_ full_name, (AccessorOpts)opts);
 
     } else {
-        payload = CAIXS_install_accessor<ObjectOnly>(aTHX_ full_name, (AccessorOpts)opts);
+        info = CAIXS_install_accessor<ObjectOnly>(aTHX_ full_name, (AccessorOpts)opts);
+        /*
+        SV* required = &PL_sv_yes;
+        SV* default_val = &PL_sv_undef;
+        caixs::meta::install(info.cv, hash_key, required, default_val);
+        */
     }
 
     STRLEN len;
     const char* hash_key_buf = SvPV_const(hash_key, len);
     SV* s_hash_key = newSVpvn_share(hash_key_buf, SvUTF8(hash_key) ? -(I32)len : (I32)len, 0);
-    payload->hash_key = s_hash_key;
+    info.payload->hash_key = s_hash_key;
 
     if (pkg_key != NULL) {
         const char* pkg_key_buf = SvPV_const(pkg_key, len);
         SV* s_pkg_key = newSVpvn_share(pkg_key_buf, SvUTF8(pkg_key) ? -(I32)len : (I32)len, 0);
-        payload->pkg_key = s_pkg_key;
+        info.payload->pkg_key = s_pkg_key;
     }
 
     if (need_cb) {
         if (SvROK(read_cb) && SvTYPE(SvRV(read_cb)) == SVt_PVCV) {
-            payload->read_cb = SvREFCNT_inc_NN(SvRV(read_cb));
+            info.payload->read_cb = SvREFCNT_inc_NN(SvRV(read_cb));
         } else {
-            payload->read_cb = NULL;
+            info.payload->read_cb = NULL;
         }
 
         if (SvROK(write_cb) && SvTYPE(SvRV(write_cb)) == SVt_PVCV) {
-            payload->write_cb = SvREFCNT_inc_NN(SvRV(write_cb));
+            info.payload->write_cb = SvREFCNT_inc_NN(SvRV(write_cb));
         } else {
-            payload->write_cb = NULL;
+            info.payload->write_cb = NULL;
         }
     }
 }
@@ -66,34 +72,34 @@ static void
 CAIXS_install_class_accessor(pTHX_ SV* full_name, SV* default_sv, bool is_varclass, int opts) {
     bool is_lazy = SvROK(default_sv) && SvTYPE(SvRV(default_sv)) == SVt_PVCV;
 
-    shared_keys* payload;
+    install_info info;
     if (is_lazy) {
-        payload = CAIXS_install_accessor<LazyClass>(aTHX_ full_name, (AccessorOpts)opts);
+        info = CAIXS_install_accessor<LazyClass>(aTHX_ full_name, (AccessorOpts)opts);
 
     } else {
-        payload = CAIXS_install_accessor<PrivateClass>(aTHX_ full_name, (AccessorOpts)opts);
+        info = CAIXS_install_accessor<PrivateClass>(aTHX_ full_name, (AccessorOpts)opts);
     }
 
     if (is_varclass) {
         GV* gv = gv_fetchsv(full_name, GV_ADD, SVt_PV);
         assert(gv);
 
-        payload->storage = GvSV(gv);
-        assert(payload->storage);
+        info.payload->storage = GvSV(gv);
+        assert(info.payload->storage);
 
         /* We take ownership of this glob slot, so if someone changes the glob - they're in trouble */
-        SvREFCNT_inc_simple_void_NN(payload->storage);
+        SvREFCNT_inc_simple_void_NN(info.payload->storage);
 
     } else {
-        payload->storage = newSV(0);
+        info.payload->storage = newSV(0);
     }
 
     if (SvOK(default_sv)) {
         if (is_lazy) {
-            payload->lazy_cb = SvREFCNT_inc_NN(SvRV(default_sv));
+            info.payload->lazy_cb = SvREFCNT_inc_NN(SvRV(default_sv));
 
         } else {
-            sv_setsv(payload->storage, default_sv);
+            sv_setsv(info.payload->storage, default_sv);
         }
     }
 }
@@ -155,6 +161,19 @@ PPCODE:
     XSRETURN_UNDEF;
 }
 
+void
+test_install_meta(SV* full_name, SV* hash_key, SV* required, SV* default_value)
+PPCODE:
+{
+    STRLEN len;
+    const char* name = SvPV_const(full_name, len);
+    CV* cv = get_cvn_flags(name, len, SVf_UTF8);
+    if (!cv) croak("Can't get cv");
+
+    caixs::meta::install(cv, hash_key, required, default_value);
+    XSRETURN_UNDEF;
+}
+
 MODULE = Class::Accessor::Inherited::XS     PACKAGE = Class::Accessor::Inherited::XS::Constants
 PROTOTYPES: DISABLE
 

diff --git a/meta.cc b/meta.cc
@@ -0,0 +1,159 @@
+#include "xs/meta.h"
+#include "xs/common.h"
+#include <new>
+
+namespace caixs { namespace meta {
+
+typedef AV* PackageMeta;
+
+static MGVTBL package_marker;
+
+static int field_meta_free(pTHX_ SV*, MAGIC* mg);
+
+struct FieldMeta {
+    SV* name;
+    SV* required;
+    SV* default_code;
+    SV* default_value;
+};
+
+
+#define FIELDS_PREALLOCADED 5
+#define FIELD_SV_COUNT (sizeof (FieldMeta) / sizeof (SV*))
+
+static PackageMeta find_package(HV* stash) {
+    MAGIC* mg = CAIXS_mg_findext((SV*)stash, PERL_MAGIC_ext, &package_marker);
+    return (PackageMeta)(mg ? mg->mg_obj : NULL);
+}
+
+static PackageMeta create_package(HV* stash) {
+    AV* meta = newAV();
+    av_extend(meta, FIELDS_PREALLOCADED * FIELD_SV_COUNT);
+
+    sv_magicext((SV*)stash, (SV*)meta, PERL_MAGIC_ext, &package_marker, NULL, 0);
+    SvREFCNT_dec_NN((SV*)meta);
+    SvRMAGICAL_off((SV*)stash);
+
+    return meta;
+}
+
+inline size_t size(PackageMeta meta) { return (AvFILLp(meta) + 1) / FIELD_SV_COUNT;}
+
+void record(PackageMeta meta, SV* hash_key, SV* required, SV* default_value) {
+    FieldMeta* fields = (FieldMeta*)AvARRAY(meta);
+
+    /* check that there might be already field meta is defined*/
+    size_t fields_sz = size(meta);
+    for(size_t i = 0; i < fields_sz; ++i) {
+        if (sv_eq(fields[i].name, hash_key)) {
+            SV* err = newSV(0);
+            sv_catpvf(err, "object key '%" SVf "' is already defined", hash_key);
+            croak_sv(err);
+        }
+    }
+
+    size_t new_sz = AvFILLp(meta) + FIELD_SV_COUNT;
+    av_fill(meta, new_sz);
+    FieldMeta& field = fields[fields_sz];
+
+    if (default_value && SvOK(default_value)) {
+        if (SvROK(default_value)) {
+            if (SvTYPE(SvRV(default_value)) == SVt_PVCV) {
+                field.default_code = SvREFCNT_inc_simple_NN(default_value);
+            }
+            else {
+                SV* err = newSV(0);
+                sv_catpvf(err, "Default values for '%" SVf "' should be either simple (string, number) or code ref", hash_key);
+                croak_sv(err);
+            }
+        }
+        else  {
+            field.default_value = SvREFCNT_inc_simple_NN(default_value);
+        }
+    }
+
+    SvREFCNT_inc_simple_NN(hash_key);
+
+    field.name = hash_key;
+    field.required = SvTRUE(required) ? &PL_sv_yes : NULL;
+}
+
+void activate(PackageMeta meta, SV *sv) {
+    HV* hv = (HV*)SvRV(sv);
+
+    FieldMeta* fields = (FieldMeta*)AvARRAY(meta);
+    size_t fields_sz = size(meta);
+    for(size_t i = 0; i < fields_sz; ++i) {
+        FieldMeta& field = fields[i];
+
+        HE* value = hv_fetch_ent(hv, field.name, 0, 0);
+        if (value) continue;
+
+        if (field.default_code) {
+            dSP;
+
+            ENTER;
+            SAVETMPS;
+
+            PUSHMARK(SP);
+            XPUSHs(sv);
+            PUTBACK;
+            int count = call_sv(fields->default_code, G_SCALAR);
+            SPAGAIN;
+
+            if (count != 1) {
+                SV* err = newSV(0);
+                sv_catpvf(err, "Got more than one item for default value of key '%" SVf "'", field.name);
+                croak_sv(err);
+            }
+
+            SV* new_val = POPs;
+            SvREFCNT_inc_NN(new_val);
+            HE* ok = hv_store_ent(hv, field.name, new_val, 0);
+            if (!ok) SvREFCNT_dec(new_val);
+
+            PUTBACK;
+            FREETMPS;
+            LEAVE;
+        } else if (field.default_value) {
+            SvREFCNT_inc(field.default_value);
+            HE* ok = hv_store_ent(hv, field.name, field.default_value, 0);
+            if (!ok) SvREFCNT_dec(field.default_value);
+        } else if (field.required == &PL_sv_yes) {
+            SV* err = newSV(0);
+            sv_catpvf(err, "key '%" SVf "' is required", field.name);
+            croak_sv(err);
+        }
+    }
+}
+
+// API-helpers
+
+void install (CV *cv, SV* hash_key, SV* required, SV *default_value) {
+    GV* gv = CvGV(cv);
+    if (!gv) croak("cant get CV's glob");
+
+    HV* stash = GvSTASH(gv);
+    if (!stash) croak("can't get stash");
+
+    PackageMeta meta = find_package(stash);
+    if (!meta) meta = create_package(stash);
+    if (!meta) return;
+
+    record(meta, hash_key, required, default_value);
+}
+
+void activate(HV* stash, SV* object) {
+    PackageMeta meta = find_package(stash);
+    if (!meta) return;
+
+    activate(meta, object);
+}
+
+
+
+}}
+
+
+
+