File Coverage

blib/lib/MooX/Role/Parameterized/Proxy.pm

Criterion	Covered	Total	%
statement	40	42	95.2
branch	4	6	66.6
condition			n/a
subroutine	12	12	100.0
pod	0	8	0.0
total	56	68	82.3

package MooX::Role::Parameterized::Proxy;
{
    $MooX::Role::Parameterized::Proxy::VERSION = '0.081';
}
use strict;
use warnings;
use Carp qw(croak);

# ABSTRACT: small proxy to offer mop methods like has, with, requires, etc.

=head1 DESCRIPTION

L is a proxy to the target class.

This proxy offer has, with, before, around, after, requires and method - to avoid inject magic around the L

=cut

sub new {
    my ( $klass, %args ) = @_;

    return bless { target => $args{target}, role => $args{role} }, $klass;
}

sub has {
    my $self = shift;
    goto &{ $self->{target} . '::has' };
}

sub with {
    my $self = shift;
    goto &{ $self->{target} . '::with' };
}

sub before {
    my $self = shift;
    goto &{ $self->{target} . '::before' };
}

sub around {
    my $self = shift;
    goto &{ $self->{target} . '::around' };

}

sub after {
    my $self = shift;
    goto &{ $self->{target} . '::after' };
}

sub requires {
    my $self   = shift;
    my $target = $self->{target};
    my $role   = $self->{role};

    if ( $target->can('requires') ) {
        goto &{"${target}::requires"};
    }
    else {
        my $required_method = shift;
        croak "Can't apply $role to $target - missing $required_method"
          if !$target->can($required_method);
    }
}

sub method {
    my ( $self, $name, $code ) = @_;
    my $target = $self->{target};

    carp("method ${target}\:\:${name} already exists, overriding...")
      if $target->can($name);

    no strict 'refs';
    *{"${target}\:\:${name}"} = $code;
}

1;