The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

use strict;
no warnings 'redefine';
sub install_ATTRIBUTES
{
my ($GBL) = @_;
*Object::InsideOut::MODIFY_SCALAR_ATTRIBUTES = sub
{
my ($pkg, $scalar, @attrs) = @_;
# Call attribute handlers in the class tree
if (exists($$GBL{'attr'}{'MOD'}{'SCALAR'})) {
@attrs = CHECK_ATTRS('SCALAR', $pkg, $scalar, @attrs);
}
# If using Attribute::Handlers, send it any unused attributes
if (@attrs &&
Attribute::Handlers::UNIVERSAL->can('MODIFY_SCALAR_ATTRIBUTES'))
{
return (Attribute::Handlers::UNIVERSAL::MODIFY_SCALAR_ATTRIBUTES($pkg, $scalar, @attrs));
}
# Return any unused attributes
return (@attrs);
};
*Object::InsideOut::CHECK_ATTRS = sub
{
my ($type, $pkg, $ref, @attrs) = @_;
# Call attribute handlers in the class tree
foreach my $class (@{$$GBL{'tree'}{'bu'}{$pkg}}) {
if (my $handler = $$GBL{'attr'}{'MOD'}{$type}{$class}) {
local $SIG{'__DIE__'} = 'OIO::trap';
@attrs = $handler->($pkg, $ref, @attrs);
return if (! @attrs);
}
}
return (@attrs); # Return remaining attributes
};
*Object::InsideOut::FETCH_ATTRS = sub
{
my ($type, $stash, $ref) = @_;
my @attrs;
# Call attribute handlers in the class tree
if (exists($$GBL{'attr'}{'FETCH'}{$type})) {
foreach my $handler (@{$$GBL{'attr'}{'FETCH'}{$type}}) {
local $SIG{'__DIE__'} = 'OIO::trap';
push(@attrs, $handler->($stash, $ref));
}
}
return (@attrs);
};
# Stub ourself out
*Object::InsideOut::install_ATTRIBUTES = sub { };
}
add_meta(__PACKAGE__, {
'MODIFY_SCALAR_ATTRIBUTES' => {'hidden' => 1},
'CHECK_ATTRS' => {'hidden' => 1},
'FETCH_ATTRS' => {'hidden' => 1},
});
sub FETCH_SCALAR_ATTRIBUTES :Sub { return (FETCH_ATTRS('SCALAR', @_)); }
sub FETCH_HASH_ATTRIBUTES :Sub { return (FETCH_ATTRS('HASH', @_)); }
sub FETCH_ARRAY_ATTRIBUTES :Sub { return (FETCH_ATTRS('ARRAY', @_)); }
sub FETCH_CODE_ATTRIBUTES :Sub { return (FETCH_ATTRS('CODE', @_)); }
} # End of package's lexical scope
# Ensure correct versioning
($Object::InsideOut::VERSION == 3.27)
or die("Version mismatch\n");
# EOF