summary refs log tree commit diff
path: root/lib/MooseX/Privacy/Meta/Class/Role.pm
blob: f9de91ed59b378caec377a1f027b1d01c016578e (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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
package MooseX::Privacy::Meta::Class::Role;

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 $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' },
    );

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

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

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

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

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

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

1;
__END__

=head1 NAME

MooseX::Privacy::Meta::Class::Role

=head1 SYNOPSIS

=head1 METHODS

=head2 local_private_attributes

Arrayref of all private attributes

  my $private_attributes = $self->meta->local_private_attributes;

=head2 local_private_methods

Arrayref of all private methods

  my $private_methods = $self->meta->local_private_methods;

=head2 add_private_method

Add a private method to your object.

  $object->meta->add_private_method('foo', sub { return 23 });

or

  $object->meta->add_private_method('foo', MooseX::Privacy::Meta::Method::Priva
te->wrap(name => 'foo', package_name => 'Foo', body => sub {return 23});

=head1 AUTHOR

franck cuny E<lt>franck@lumberjaph.netE<gt>

=head1 SEE ALSO

=head1 LICENSE

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut