Moo like

meta.cc

@@ -13,6 +13,7 @@ static int field_meta_free(pTHX_ SV*, MAGIC* mg);
 struct FieldMeta {
     SV* name;
     SV* required;
+    SV* default_code;
     SV* default_value;
 };
 
@@ -51,19 +52,28 @@ void record(PackageMeta meta, SV* hash_key, SV* required, SV* default_value) {
         }
     }
 
-    if (SvOK(default_value) && (!SvROK(default_value) || SvTYPE(SvRV(default_value)) != SVt_PVCV))
-        croak("'default' should be a code reference");
-
     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);
-    SvREFCNT_inc_simple(default_value);
-    FieldMeta& field = fields[fields_sz];
 
     field.name = hash_key;
     field.required = SvTRUE(required) ? &PL_sv_yes : NULL;
-    field.default_value = default_value;
 }
 
 void activate(PackageMeta meta, SV *sv) {
@@ -74,42 +84,43 @@ void activate(PackageMeta meta, SV *sv) {
     for(size_t i = 0; i < fields_sz; ++i) {
         FieldMeta& field = fields[i];
 
-        if (SvOK(field.default_value)) {
-            HE* value = hv_fetch_ent(hv, field.name, 0, 0);
-            if (!value) {
-                dSP;
-
-                ENTER;
-                SAVETMPS;
-
-                PUSHMARK(SP);
-                XPUSHs(sv);
-                PUTBACK;
-                int count = call_sv(fields->default_value, G_SCALAR);
-                SPAGAIN;
-
-                if (count != 1) {
-                    SV* err = newSV(0);
-                    sv_catpvf(err, "unexpected return from 'default' of '%" SVf "': %d insead of expected 1", field.name, count);
-                    croak_sv(err);
-                }
-
-                SV* new_val = POPs;
-                SvREFCNT_inc(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.required == &PL_sv_yes) {
-            HE* value = hv_fetch_ent(hv, field.name, 0, 0);
-            if (!value) {
+        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, "key '%" SVf "' is required", field.name);
+                sv_catpvf(err, "unexpected return from 'default' of '%" SVf "': %d insead of expected 1", field.name, count);
                 croak_sv(err);
             }
+
+            SV* new_val = POPs;
+            SvREFCNT_inc(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);
         }
     }
 }

t/xx-mine.t

@@ -28,7 +28,7 @@ subtest "check required" => sub {
     };
 };
 
-subtest "check default" => sub {
+subtest "check default (code)" => sub {
     my $package = 't::P' . __LINE__;
     my $default = \"default-value";
     my $sub = sub {
@@ -45,7 +45,41 @@ subtest "check default" => sub {
     is $package->new->{foo}, undef;
 };
 
+subtest "check default (value)" => sub {
+    subtest "common case" => sub {
+        my $package = 't::P' . __LINE__;
+        my $default = "default-value";
+        install($package, 'foo', 0, $default);
+        is $package->new->{foo}, $default;
+        is $package->new(foo => 'v')->{foo}, 'v';
+    };
+    subtest "zero" => sub {
+        my $package = 't::P' . __LINE__;
+        my $default = 0;
+        install($package, 'foo', 0, $default);
+        is $package->new->{foo}, $default;
+    };
+    subtest "empty string" => sub {
+        my $package = 't::P' . __LINE__;
+        my $default = '';
+        install($package, 'foo', 0, $default);
+        is $package->new->{foo}, $default;
+    };
+    subtest "undef" => sub {
+        my $package = 't::P' . __LINE__;
+        my $default;
+        install($package, 'foo', 0, $default);
+        is $package->new->{foo}, $default;
+    };
+};
 
+subtest "check default (non-code references are prohibed)" => sub {
+    my $package = 't::P' . __LINE__;
+    my $default = \"default-value";
+    my $ok = eval { install($package, 'foo', 0, $default); 1 };
+    ok !$ok;
+    like $@, qr/\QDefault values for 'foo' should be either simple (string, number) or code ref\E/;
+};
 
 SKIP: {
     skip 'utf8 support on this perl is broken'. 1 if $] < 5.016;