File Coverage

blib/lib/Object/InsideOut/attributes.pm

Criterion	Covered	Total	%
statement	43	47	91.4
branch	7	10	70.0
condition	1	3	33.3
subroutine	12	15	80.0
pod			n/a
total	63	75	84.0

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.04')
    or die("Version mismatch\n");

# EOF