File Coverage

blib/lib/Class/Component/Plugin.pm

Criterion	Covered	Total	%
statement	75	79	94.9
branch	17	28	60.7
condition	3	5	60.0
subroutine	22	22	100.0
pod	5	6	83.3
total	122	140	87.1

package Class::Component::Plugin;

use strict;
use warnings;
use base qw( Class::Accessor::Fast Class::Data::Inheritable );

__PACKAGE__->mk_accessors(qw/ config /);
__PACKAGE__->mk_classdata( '__attr_cache' => {} );
__PACKAGE__->mk_classdata( '__methods_cache' );

use Carp::Clan qw/Class::Component/;
use Class::Inspector;
use UNIVERSAL::require;

sub new {
    my($class, $config, $c) = @_;
    my $self = bless {}, $class;
    $self->config($config);
    $self->init($c);
    $self;
}

sub init {}

my %attribute_detect_cache = ();
sub class_component_plugin_attribute_detect_cache_enable { 1 };
sub class_component_plugin_attribute_detect {
    my($self, $attr, $cache_key) = @_;
    $attribute_detect_cache{$cache_key} = [];

    return unless my($key, $value) = ($attr =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/);
    unless (defined $value) {
        $attribute_detect_cache{$cache_key} = [$key, $value];
        return ($key, $value);
    }

    my $pkg    = ref $self;
    # from Attribute::Handlers
    my $evaled = eval "package $pkg; no warnings; local \$SIG{__WARN__} = sub{ die \@_ }; [$value]"; ## no critic
    $@ and croak "$pkg: $value: $@";
    my $data   = $evaled || [$value];
    $value     = (@{ $data } > 1) ? $data : $data->[0];

    $attribute_detect_cache{$cache_key} = [$key, $value];
    return ($key, $value);
}

sub class_component_load_attribute_resolver { }

sub register {
    my($self, $c) = @_;

    unless ($self->__methods_cache) {
        my @methods;
        for my $method (@{ Class::Inspector->methods(ref $self) || [] }) {
            next unless my $code = $self->can($method);
            next unless my $attrs = $self->__attr_cache->{$code};
            push @methods, { method => $method, code => $code, attrs => $attrs };
        }
        $self->__methods_cache( \@methods );
    }

    my $is_attribute_detect_cache = $self->class_component_plugin_attribute_detect_cache_enable;
    my $class = ref $self;
    for my $data (@{ $self->__methods_cache }) {
        for my $attr (@{ $data->{attrs} }) {
            my($key, $value);
            my $cache_key = "$class\::$attr";
            my $attr_res  = $attribute_detect_cache{$cache_key};
            if ($is_attribute_detect_cache && $attr_res) {
                ($key, $value) = ( $attr_res->[0], $attr_res->[1] );
            } else {
                next unless ($key, $value) = $self->class_component_plugin_attribute_detect($attr, $cache_key);
            }

            my $attr_class;
            if (my $pkg = $self->class_component_load_attribute_resolver($key)) {
                $pkg->require or croak $@;
                $attr_class = $pkg;
            } else {
                $attr_class = Class::Component::Implement->pkg_require($c => "Attribute::$key");
            }
            unless ($attr_class) {
                next unless $@;
                croak "'$key' is not supported attribute";
            }
            $attr_class->register($self, $c, $data->{method}, $value, $data->{code});
        }
    }
}

sub MODIFY_CODE_ATTRIBUTES {
    my($class, $code, @attrs) = @_;
    $class->__attr_cache->{$code} = [@attrs];
    return ();
}

1;
__END__