Skip to content

Add support for lazy builders #14

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
tobyink wants to merge 2 commits into
base: master
Choose a base branch
from
Open

Add support for lazy builders #14

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
9c67f49
Add support for lazy builders
tobyink Dec 5, 2025
c70ec87
Somehow I broke this in copy and pasting
tobyink Dec 7, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
142 changes: 137 additions & 5 deletions XS/Hash.xs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down Expand Up @@ -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;
Expand All @@ -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;
Expand Down Expand Up @@ -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;
Expand All @@ -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;
Expand All @@ -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;
Expand All @@ -298,17 +424,23 @@ 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 { /* newxs_accessor */
else if (ix == 1) { /* newxs_accessor */
if (chained)
INSTALL_NEW_CV_HASH_OBJ(name, CXAH(chained_accessor), key, keylen);
else
INSTALL_NEW_CV_HASH_OBJ(name, CXAH(accessor), key, keylen);
}
else { /* newxs_lzaccessor */
if (chained)
INSTALL_NEW_CV_HASH_OBJ(name, CXAH(chained_lzaccessor), key, keylen);
else
INSTALL_NEW_CV_HASH_OBJ(name, CXAH(lzaccessor), key, keylen);
}

void
newxs_constructor(namesv)
Expand Down
2 changes: 2 additions & 0 deletions XSAccessor.xs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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));
Expand Down
38 changes: 38 additions & 0 deletions lib/Class/XSAccessor.pm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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} || {});
Expand All @@ -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],
Expand Down Expand Up @@ -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);
}
Expand All @@ -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);
}
Expand Down Expand Up @@ -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<lazy_getters> option.

=head1 CAVEATS

Probably won't work for objects based on I<tied> hashes. But that's a strange thing to do anyway.
Expand Down
59 changes: 59 additions & 0 deletions t/11hash_lazy.t
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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 );
Loading