File Coverage

blib/lib/Class/Component/Component/Autocall/InjectMethod.pm

Criterion	Covered	Total	%
statement	38	44	86.3
branch	7	10	70.0
condition	3	6	50.0
subroutine	9	11	81.8
pod	0	2	0.0
total	57	73	78.0

package Class::Component::Component::Autocall::InjectMethod;

use strict;
use warnings;

use Carp::Clan qw/Class::Component/;

sub register_method {
    my($self, @methods) = @_;
    my $class = ref($self) || $self;

    $self->NEXT( register_method => @methods );
    while (my($method, $plugin) = splice @methods, 0, 2) {
        next unless $plugin;
        no strict 'refs';
        no warnings 'redefine';
        unless (ref $plugin eq 'HASH') {
            *{"$class\::$method"} = sub { $plugin->$method(shift, @_) };
            next;
        }

        # extend method
        my $obj         = $plugin;
        $plugin         = $obj->{plugin};
        my $real_method = $obj->{method};
        next unless $plugin && $real_method;
        if (ref $real_method eq 'CODE') {
            *{"$class\::$method"} = sub { $real_method->($plugin, shift, @_) };
        } elsif (!ref($real_method)) {
            *{"$class\::$method"} = sub { $plugin->$real_method(shift, @_) };
        }
    }
}

sub remove_method {
    my($self, @methods) = @_;
    $self->NEXT( remove_method => @methods );
    while (my($method, $plugin) = splice @methods, 0, 2) {
        no strict 'refs';
        delete ${ref($self) . "::"}{$method};
    }
}

1;