/usr/share/perl5/Object/InsideOut/attributes.pm is in libobject-insideout-perl 4.02-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 | package Object::InsideOut; {
use strict;
use warnings;
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('Object::InsideOut', {
'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 eq '4.02')
or die("Version mismatch\n");
# EOF
|