summary refs log tree commit diff
path: root/lib/MooseX/Privacy/Meta/Class/Role.pm
blob: 55439394b4cb00653acee9f4cfd7c8ee9c7efa13 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
package MooseX::Privacy::Meta::Class::Role;

# ABSTRACT: Private and Protected parameterized roles

use MooseX::Role::Parameterized;
use Scalar::Util;
use Carp qw/confess/;
use MooseX::Types::Moose qw/Str ArrayRef/;

use MooseX::Privacy::Meta::Method::Protected;
use MooseX::Privacy::Meta::Method::Private;

parameter name => ( isa => 'Str', required => 1, );

role {
    my $p = shift;

    my $name             = $p->name;
    my $local_methods        = "local_" . $name . "_methods";
    my $local_attributes     = "local_" . $name . "_attributes";
    my $push_method          = "_push_" . $name . "_method";
    my $push_attribute       = "_push_" . $name . "_attribute";
    my $count_methods        = "_count_" . $name . "_methods";
    my $count_attributes     = "_count_" . $name . "_attributes";
    my $get_method           = 'get_' . $name . '_method';
    my $get_all_mehods       = 'get_all_' . $name . '_methods';
    my $get_all_methods_name = 'get_all_' . $name . '_method_names';
    my $meta_method          = "add_" . $name . "_method";

    has $local_methods => (
        traits     => ['Array'],
        is         => 'ro',
        isa        => ArrayRef [Str],
        required   => 1,
        default    => sub { [] },
        auto_deref => 1,
        handles    => { $push_method => 'push', $count_methods => 'count' },
    );

    has $local_attributes => (
        traits     => ['Array'],
        is         => 'ro',
        isa        => ArrayRef [Str],
        required   => 1,
        default    => sub { [] },
        auto_deref => 1,
        handles =>
            { $push_attribute => 'push', $count_attributes => 'count' },
    );

    method $meta_method => sub {
        my ( $self, $method_name, $body ) = @_;

        my $class = "MooseX::Privacy::Meta::Method::" . ( ucfirst $name );

        my $method = blessed $body ? $body : $class->wrap(
            name         => $method_name,
            package_name => $self->name,
            body         => $body
        );

        confess $method_name . " is not a " . $name . " method"
            unless $method->isa($class);

        $self->add_method( $method->name, $method );
        $self->$push_method( $method->name );
    };
};

1;