From 9c67f49ceab12e9c196058989ffaaa86243596a9 Mon Sep 17 00:00:00 2001 From: Toby Inkster Date: Fri, 5 Dec 2025 17:01:08 +0000 Subject: [PATCH 1/2] Add support for lazy builders --- XS/Hash.xs | 146 ++++++++++++++++++++++++++++++++++++++-- XSAccessor.xs | 2 + lib/Class/XSAccessor.pm | 38 +++++++++++ t/11hash_lazy.t | 59 ++++++++++++++++ 4 files changed, 238 insertions(+), 7 deletions(-) create mode 100644 t/11hash_lazy.t diff --git a/XS/Hash.xs b/XS/Hash.xs index ca87a75..28c38a3 100644 --- a/XS/Hash.xs +++ b/XS/Hash.xs @@ -42,6 +42,41 @@ getter(self) else XSRETURN_UNDEF; +void +lzgetter(self) + SV* self; + INIT: + /* Get the const hash key struct from the global storage */ + const autoxs_hashkey * readfrom = CXAH_GET_HASHKEY; + SV** svp; + PPCODE: + CXA_CHECK_HASH(self); + CXAH_OPTIMIZE_ENTERSUB(lzgetter); + if ((svp = CXSA_HASH_FETCH((HV *)SvRV(self), readfrom->key, readfrom->len, readfrom->hash))) { + PUSHs(*svp); + } + else { + SV* const builder = newSVpv("_build_", 7); + sv_catpvn(builder, readfrom->key, readfrom->len); + STRLEN len; + const char *methodname = SvPV(builder, len); + SV* newvalue; + ENTER; + SAVETMPS; + PUSHMARK(SP); + XPUSHs(self); + PUTBACK; + call_method(methodname, G_SCALAR); + SPAGAIN; + newvalue = newSVsv(POPs); + PUTBACK; + FREETMPS; + LEAVE; + if (NULL == hv_store((HV*)SvRV(self), readfrom->key, readfrom->len, newSVsv(newvalue), readfrom->hash)) + croak("Failed to write new value to hash."); + PUSHs(newvalue); + } + void lvalue_accessor(self) SV* self; @@ -119,6 +154,49 @@ accessor(self, ...) XSRETURN_UNDEF; } +void +lzaccessor(self, ...) + SV* self; + INIT: + /* Get the const hash key struct from the global storage */ + const autoxs_hashkey * readfrom = CXAH_GET_HASHKEY; + SV** svp; + PPCODE: + CXA_CHECK_HASH(self); + CXAH_OPTIMIZE_ENTERSUB(lzaccessor); + if (items > 1) { + SV* newvalue = ST(1); + if (NULL == hv_store((HV*)SvRV(self), readfrom->key, readfrom->len, newSVsv(newvalue), readfrom->hash)) + croak("Failed to write new value to hash."); + PUSHs(newvalue); + } + else { + if ((svp = CXSA_HASH_FETCH((HV *)SvRV(self), readfrom->key, readfrom->len, readfrom->hash))) { + PUSHs(*svp); + } + else { + SV* const builder = newSVpv("_build_", 7); + sv_catpvn(builder, readfrom->key, readfrom->len); + STRLEN len; + const char *methodname = SvPV(builder, len); + SV* newvalue = ST(1); + ENTER; + SAVETMPS; + PUSHMARK(SP); + XPUSHs(self); + PUTBACK; + call_method(methodname, G_SCALAR); + SPAGAIN; + newvalue = newSVsv(POPs); + PUTBACK; + FREETMPS; + LEAVE; + if (NULL == hv_store((HV*)SvRV(self), readfrom->key, readfrom->len, newSVsv(newvalue), readfrom->hash)) + croak("Failed to write new value to hash."); + PUSHs(newvalue); + } + } + void chained_accessor(self, ...) SV* self; @@ -142,6 +220,49 @@ chained_accessor(self, ...) XSRETURN_UNDEF; } +void +chained_lzaccessor(self, ...) + SV* self; + INIT: + /* Get the const hash key struct from the global storage */ + const autoxs_hashkey * readfrom = CXAH_GET_HASHKEY; + SV** svp; + PPCODE: + CXA_CHECK_HASH(self); + CXAH_OPTIMIZE_ENTERSUB(chained_accessor); + if (items > 1) { + SV* newvalue = ST(1); + if (NULL == hv_store((HV*)SvRV(self), readfrom->key, readfrom->len, newSVsv(newvalue), readfrom->hash)) + croak("Failed to write new value to hash."); + PUSHs(self); + } + else { + if ((svp = CXSA_HASH_FETCH((HV *)SvRV(self), readfrom->key, readfrom->len, readfrom->hash))) { + PUSHs(*svp); + } + else { + SV* const builder = newSVpv("_build_", 7); + sv_catpvn(builder, readfrom->key, readfrom->len); + STRLEN len; + const char *methodname = SvPV(builder, len); + SV* newvalue = ST(1); + ENTER; + SAVETMPS; + PUSHMARK(SP); + XPUSHs(self); + PUTBACK; + call_method(methodname, G_SCALAR); + SPAGAIN; + newvalue = newSVsv(POPs); + PUTBACK; + FREETMPS; + LEAVE; + if (NULL == hv_store((HV*)SvRV(self), readfrom->key, readfrom->len, newSVsv(newvalue), readfrom->hash)) + croak("Failed to write new value to hash."); + PUSHs(newvalue); + } + } + void exists_predicate(self) SV* self; @@ -253,6 +374,7 @@ newxs_getter(namesv, keysv) Class::XSAccessor::newxs_predicate = 2 Class::XSAccessor::newxs_defined_predicate = 3 Class::XSAccessor::newxs_exists_predicate = 4 + Class::XSAccessor::newxs_lzgetter = 5 PREINIT: char *name; char *key; @@ -278,6 +400,9 @@ newxs_getter(namesv, keysv) case 4: INSTALL_NEW_CV_HASH_OBJ(name, CXAH(exists_predicate), key, keylen); break; + case 5: /* newxs_lzgetter */ + INSTALL_NEW_CV_HASH_OBJ(name, CXAH(lzgetter), key, keylen); + break; default: croak("Invalid alias of newxs_getter called"); break; @@ -290,6 +415,7 @@ newxs_setter(namesv, keysv, chained) bool chained; ALIAS: Class::XSAccessor::newxs_accessor = 1 + Class::XSAccessor::newxs_lzaccessor = 2 PREINIT: char *name; char *key; @@ -298,16 +424,22 @@ newxs_setter(namesv, keysv, chained) name = SvPV(namesv, namelen); key = SvPV(keysv, keylen); if (ix == 0) { /* newxs_setter */ - if (chained) - INSTALL_NEW_CV_HASH_OBJ(name, CXAH(chained_setter), key, keylen); - else - INSTALL_NEW_CV_HASH_OBJ(name, CXAH(setter), key, keylen); + if (chained) + INSTALL_NEW_CV_HASH_OBJ(name, CXAH(chained_setter), key, keylen); + else + INSTALL_NEW_CV_HASH_OBJ(name, CXAH(setter), key, keylen); + } + else if (ix == 1) { /* newxs_accessor */ + if (chained) + INSTALL_NEW_CV_HASH_OBJ(name, CXAH(chained_setter), key, keylen); + else + INSTALL_NEW_CV_HASH_OBJ(name, CXAH(setter), key, keylen); } - else { /* newxs_accessor */ + else { /* newxs_lzaccessor */ if (chained) - INSTALL_NEW_CV_HASH_OBJ(name, CXAH(chained_accessor), key, keylen); + INSTALL_NEW_CV_HASH_OBJ(name, CXAH(chained_lzaccessor), key, keylen); else - INSTALL_NEW_CV_HASH_OBJ(name, CXAH(accessor), key, keylen); + INSTALL_NEW_CV_HASH_OBJ(name, CXAH(lzaccessor), key, keylen); } void diff --git a/XSAccessor.xs b/XSAccessor.xs index bc125c6..3ca4420 100644 --- a/XSAccessor.xs +++ b/XSAccessor.xs @@ -399,6 +399,8 @@ CXA_Setup_Xsub_Hash(constant_false); CXA_Setup_Xsub_Hash(constant_true); CXA_Setup_Xsub_Hash(defined_predicate); CXA_Setup_Xsub_Hash(exists_predicate); +CXA_Setup_Xsub_Hash(lzgetter); +CXA_Setup_Xsub_Hash(lzaccessor); /* special case for test function */ XS(CXAH(test)); diff --git a/lib/Class/XSAccessor.pm b/lib/Class/XSAccessor.pm index fdc6e38..46f1b47 100644 --- a/lib/Class/XSAccessor.pm +++ b/lib/Class/XSAccessor.pm @@ -35,8 +35,10 @@ sub import { # TODO: Refactor. Move more duplicated code to ::Heavy my $read_subs = _make_hash($opts{getters} || {}); + my $read_lzsubs = _make_hash($opts{lazy_getters} || {}); my $set_subs = _make_hash($opts{setters} || {}); my $acc_subs = _make_hash($opts{accessors} || {}); + my $acc_lzsubs = _make_hash($opts{lazy_accessors} || {}); my $lvacc_subs = _make_hash($opts{lvalue_accessors} || {}); my $pred_subs = _make_hash($opts{predicates} || {}); my $ex_pred_subs = _make_hash($opts{exists_predicates} || {}); @@ -47,8 +49,10 @@ sub import { my $false_subs = $opts{false} || []; foreach my $subtype ( ["getter", $read_subs], + ["lazy_getter", $read_lzsubs], ["setter", $set_subs], ["accessor", $acc_subs], + ["lazy_accessor", $acc_lzsubs], ["lvalue_accessor", $lvacc_subs], ["test", $test_subs], ["ex_predicate", $ex_pred_subs], @@ -86,6 +90,9 @@ sub _generate_method { if ($type eq 'getter') { newxs_getter($subname, $hashkey); } + elsif ($type eq 'lazy_getter') { + newxs_lzgetter($subname, $hashkey); + } elsif ($type eq 'lvalue_accessor') { newxs_lvalue_accessor($subname, $hashkey); } @@ -110,6 +117,9 @@ sub _generate_method { elsif ($type eq 'test') { newxs_test($subname, $hashkey); } + elsif ($type eq 'lazy_accessor') { + newxs_lzaccessor($subname, $hashkey, $opts->{chained}||0); + } else { newxs_accessor($subname, $hashkey, $opts->{chained}||0); } @@ -279,6 +289,34 @@ The following example demonstrates an lvalue accessor: $address->zip_code = 76135; # <--- This is it! print $address->zip_code, "\n"; # prints 76135 +=head1 LAZY BUILDERS + +Support for lazy builders was added in version 1.20. + + package Counter; + use Class::XSAccessor + constructor => 'new', + lazy_accessors => { count => 'count' }; + sub _build_count { + my $self = shift; + return 0; + } + sub increment { + my $self = shift; + $self->count( $self->count + 1 ); + return $self; + } + + package main; + print Counter->new(count => 2)->incremement->count, "\n"; # 3 + print Counter->new()->incremement->count, "\n"; # 1 + +The builder is always a method named "_build_" followed by the hash key +the accessor is providing access to. The builder method will be called +if the accessor is called as a reader, but the hash key does not exist. + +There is similarly a L option. + =head1 CAVEATS Probably won't work for objects based on I hashes. But that's a strange thing to do anyway. diff --git a/t/11hash_lazy.t b/t/11hash_lazy.t new file mode 100644 index 0000000..0686b6c --- /dev/null +++ b/t/11hash_lazy.t @@ -0,0 +1,59 @@ +use strict; +use warnings; + +package Class::XSAccessor::Test; +use Class::XSAccessor + lazy_accessors => { bar => 'bar' }, + lazy_getters => { get_foo => 'foo' }; +sub new { + my $class = shift; + bless { @_ }, $class; +} +sub _build_foo { + my $self = shift; + return ref($self) ? 111 : 333; +} +sub _build_bar { + my $self = shift; + return wantarray ? 444 : 222; +} +sub _build_get_foo { + die "This should never be called."; +} + +package Class::XSAccessor::TestChained; +our @ISA = 'Class::XSAccessor::Test'; +use Class::XSAccessor + chained => 1, + lazy_accessors => { bar => 'bar' }, + lazy_getters => { get_foo => 'foo' }; + +package main; +use Test::More tests => 18; + +my $t1 = Class::XSAccessor::Test->new( foo => 42, bar => 43 ); +is( $t1->get_foo, 42 ); +is( $t1->bar, 43 ); + +my $t2 = Class::XSAccessor::Test->new; +ok( !exists $t2->{foo} ); +is( $t2->get_foo, 111 ); +is( $t2->{foo}, 111 ); +ok( !exists $t2->{bar} ); +is( $t2->bar, 222 ); +is( $t2->{bar}, 222 ); +ok !eval { $t2->get_foo(333); 1 }; + +my $t3 = Class::XSAccessor::Test->new( foo => undef, bar => undef ); +is( $t3->get_foo, undef ); +is( $t3->bar, undef ); +ok( !defined $t3->{bar} ); +delete $t3->{bar}; +ok( !exists $t3->{bar} ); +is( $t3->bar, 222 ); +is( $t3->{bar}, 222 ); + +my $t4 = Class::XSAccessor::TestChained->new( foo => 42, bar => 43 ); +is( $t4->get_foo, 42 ); +is( $t4->bar, 43 ); +is( $t4->bar(55), $t4 ); From c70ec8704d16a57b185ab5b86cd019936923260d Mon Sep 17 00:00:00 2001 From: Toby Inkster Date: Sun, 7 Dec 2025 09:42:21 +0000 Subject: [PATCH 2/2] Somehow I broke this in copy and pasting --- XS/Hash.xs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/XS/Hash.xs b/XS/Hash.xs index 28c38a3..bad1bd3 100644 --- a/XS/Hash.xs +++ b/XS/Hash.xs @@ -431,9 +431,9 @@ newxs_setter(namesv, keysv, chained) } else if (ix == 1) { /* newxs_accessor */ if (chained) - INSTALL_NEW_CV_HASH_OBJ(name, CXAH(chained_setter), key, keylen); + INSTALL_NEW_CV_HASH_OBJ(name, CXAH(chained_accessor), key, keylen); else - INSTALL_NEW_CV_HASH_OBJ(name, CXAH(setter), key, keylen); + INSTALL_NEW_CV_HASH_OBJ(name, CXAH(accessor), key, keylen); } else { /* newxs_lzaccessor */ if (chained)