The example below is combines traits (S14) Lvalue subs (S06) to create a
base class SimpleTiedHash that ties Attributes to the hash using the
'Entry' accessor.
PDFCatalog is an example instance class.
This mostly works well. But SimpleTiedHash currently has a hacky way of
overriding the built-in accessor.
-- The :entry trait detects then overrides the Attribute `has_accessor
property, setting it back to false. This `fools` Perl6 class system into
not generating a standard accessor.
-- The SimpleTiedHash.compose method only needs to be invoked once per
class instance initialization, but is currently getting called too late and
repeatedly via the new method.
Is there a better way of adding custom accessors from traits, just once
when classes are being initialized?
Code sample below
- David
==================================
my role TiedAtt {
has Bool $.is-entry = True;
has Bool $.gen-accessor is rw;
has method has_accessor { False }
}
multi trait_mod:<is>(Attribute $att is rw, :$entry!) is export(:DEFAULT) {
# fool rakudo into not generating a standard accessor
my $gen-accessor = $att.has_accessor;
$att does TiedAtt;
$att.gen-accessor = $gen-accessor;
}
class SimpleTiedHash
is Hash {
# base class
sub att-accessor($obj, Str $key, Attribute $att) {
Proxy.new(
FETCH => method {
$obj{$key};
},
STORE => method ($val is copy) {
# simple typecheck
die "$key: {$val.perl} has wrong type"
unless $val ~~ $att.type;
$obj{$key} = $val;
});
}
# create accessors
method compose {
for self.^attributes.grep({ .name ~~ /^'$!'<[A..Z]>/ &&
.can('is-entry'\
) }) -> $att {
my $key = $att.name.subst(/^'$!'/, '');
warn "setting up attribute $key";
if $att.gen-accessor && ! self.^declares_method($key) {
$att.set_rw;
self.^add_method( $key, method {
att-accessor(self, $key, $att ) } );
}
}
}
method new(|c) {
my $obj = callsame;
# happening too late.
# should ideally be invoked once during class initialisation
warn "composing...";
$obj.compose();
$obj;
}
}
class PDFCatalog
is SimpleTiedHash {
# data instance class
has Str $.Version is entry;
has Hash $.Pages is entry;
method ping{say 42}
}
my $cat = PDFCatalog.new;
$cat.ping;
$cat.Version = '1.3';
$cat.Pages = { :Count(0), :Kids[] };
say $cat.Version;
say $cat<Version>;
say $cat.Pages.perl;
