view release on metacpan or  search on metacpan

lib/Role.pm  view on Meta::CPAN

package Role;

use strict;
use warnings;
use version;

our $VERSION   = qv('v0.1.1');
our $AUTHORITY = 'cpan:MANWAR';

our %REQUIRED_METHODS;
our %IS_ROLE;
our %EXCLUDED_ROLES;
our %APPLIED_ROLES;
our %METHOD_ALIASES;
our %ROLE_ATTRIBUTES;
our %METHOD_ORIGIN_CACHE;
our %ROLE_LOAD_CACHE;
our %CAN_HANDLE_ATTR_CACHE;
our %ROLE_METHODS_CACHE;

# Precomputed skip patterns
my %SKIP_METHODS = map { $_ => 1 } qw(
    BEGIN END import DESTROY new requires
    excludes IS_ROLE with has does
    AUTOLOAD VERSION AUTHORITY INC
);

sub import {
    my ($class, @args) = @_;
    my $caller = caller;
    no strict 'refs';

    $IS_ROLE{$caller} = 1;

    if (@args == 0) {
        $REQUIRED_METHODS{$caller} = [];
        *{"${caller}::requires"} = \&requires;
        *{"${caller}::excludes"} = \&excludes;
        *{"${caller}::has"} = \&_role_has;
    } else {
        _setup_role_application($caller, @args);
    }

    strict->import;
    warnings->import;
    _export_with($caller);
}

sub with {
    my (@roles) = @_;
    my $caller = caller;

    # Called inside a ROLE
    if ($IS_ROLE{$caller}) {
        my ($clean_roles_ref, $aliases_by_role)
            = _process_role_arguments(@roles);
        $METHOD_ALIASES{$caller} = $aliases_by_role;

        foreach my $role (@$clean_roles_ref) {
            _ensure_role_loaded($role);
            push @{ $APPLIED_ROLES{$caller} ||= [] }, $role;

            # Merge required methods
            if (my $req = $REQUIRED_METHODS{$role}) {
                push @{ $REQUIRED_METHODS{$caller} ||= [] }, @$req;
            }
        }

        return;
    }

    apply_role($caller, @roles);
}

sub requires {
    my (@methods) = @_;
    my $caller = caller;
    $REQUIRED_METHODS{$caller} = [] unless exists $REQUIRED_METHODS{$caller};
    push @{$REQUIRED_METHODS{$caller}}, @methods;
}

sub excludes {
    my (@excluded_roles) = @_;
    my $caller = caller;
    $EXCLUDED_ROLES{$caller} = [] unless exists $EXCLUDED_ROLES{$caller};
    push @{$EXCLUDED_ROLES{$caller}}, @excluded_roles;
}

sub apply_role {
    my ($class, @roles) = @_;
    my $target_class = ref($class) ? ref($class) : $class;
    my ($clean_roles_ref, $aliases_by_role) =
        _process_role_arguments(@roles);

    $METHOD_ALIASES{$target_class} = {
        %{$METHOD_ALIASES{$target_class} || {}},
        %$aliases_by_role
    };

    foreach my $role (@$clean_roles_ref) {
        _apply_single_role($target_class, $role);
    }

    _add_does_method($target_class);