diff options
author | franck cuny <franck@lumberjaph.net> | 2010-04-28 21:56:04 +0200 |
---|---|---|
committer | franck cuny <franck@lumberjaph.net> | 2010-04-28 21:56:04 +0200 |
commit | 0991853ed61b3c354f579cdd34cfc23814867f4a (patch) | |
tree | 43df090c84e918e6ea2612f124c1f201922a0557 | |
parent | update tests (diff) | |
download | moosex-privacy-0991853ed61b3c354f579cdd34cfc23814867f4a.tar.gz |
parameterized role for private and protected
-rw-r--r-- | lib/MooseX/Privacy/Meta/Class/Role.pm | 106 |
1 files changed, 106 insertions, 0 deletions
diff --git a/lib/MooseX/Privacy/Meta/Class/Role.pm b/lib/MooseX/Privacy/Meta/Class/Role.pm new file mode 100644 index 0000000..f9de91e --- /dev/null +++ b/lib/MooseX/Privacy/Meta/Class/Role.pm @@ -0,0 +1,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 |