File Coverage

blib/lib/Eidolon/Core/Attributes.pm

Criterion	Covered	Total	%
statement	28	30	93.3
branch	1	2	50.0
condition			n/a
subroutine	6	7	85.7
pod			n/a
total	35	39	89.7

package Eidolon::Core::Attributes;
# ==============================================================================
#
#   Eidolon
#   Copyright (c) 2009, Atma 7
#   ---
#   Eidolon/Core/Attributes.pm - base class for attributes handling
#
# ==============================================================================

use warnings;
use strict;

our $VERSION = "0.02"; # 2009-05-14 04:57:12

# ------------------------------------------------------------------------------
# @ MODIFY_CODE_ATTRIBUTES($class, $code, @attrs)
# modify code attributes (God bless guys from the Catalyst team)
# ------------------------------------------------------------------------------
sub MODIFY_CODE_ATTRIBUTES
{
    my ($class, $code, @attrs) = @_;

    {
        no strict "refs";

        unless (defined ${$class."::_code_cache"})
        {
            ${ $class."::_code_cache" } = {};
            ${ $class."::_attr_cache" } = {};

            *{ $class."::code_cache"  } = sub { return ${ $_[0]."::_code_cache" } };
            *{ $class."::attr_cache"  } = sub { return ${ $_[0]."::_attr_cache" } };
        }
    }

    $class->attr_cache->{$code} = [ @attrs ];
    $class->code_cache->{$_}    = $code foreach (@attrs);

    return ();
}

# ------------------------------------------------------------------------------
# @ FETCH_CODE_ATTRIBUTES($class, $code)
# read code attributes
# ------------------------------------------------------------------------------
sub FETCH_CODE_ATTRIBUTES
{
    return @{ $_[0]->attr_cache->{$_[1]} };
}

1;

__END__