#!/usr/bin/perl -w use strict; use Test::More 'no_plan'; use Test::Fatal; $| = 1; # =begin testing SETUP { package MyApp::Meta::Method::PrivateOrPublic; use Moose; use Moose::Util::TypeConstraints; extends 'Moose::Meta::Method'; has '_policy' => ( is => 'ro', isa => enum( [ qw( public private ) ] ), default => 'public', init_arg => 'policy', ); sub new { my $class = shift; my %options = @_; my $self = $class->SUPER::wrap(%options); $self->{_policy} = $options{policy}; $self->_add_policy_wrapper; return $self; } sub _add_policy_wrapper { my $self = shift; return if $self->is_public; my $name = $self->name; my $package = $self->package_name; my $real_body = $self->body; my $body = sub { die "The $package\::$name method is private" unless ( scalar caller() ) eq $package; goto &{$real_body}; }; $self->{body} = $body; } sub is_public { $_[0]->_policy eq 'public' } sub is_private { $_[0]->_policy eq 'private' } package MyApp::User; use Moose; has 'password' => ( is => 'rw' ); __PACKAGE__->meta()->add_method( '_reset_password', MyApp::Meta::Method::PrivateOrPublic->new( name => '_reset_password', package_name => __PACKAGE__, body => sub { $_[0]->password('reset') }, policy => 'private', ) ); } # =begin testing { package main; use strict; use warnings; use Test::Fatal; my $user = MyApp::User->new( password => 'foo!' ); like( exception { $user->_reset_password }, qr/The MyApp::User::_reset_password method is private/, '_reset_password method dies if called outside MyApp::User class'); { package MyApp::User; sub run_reset { $_[0]->_reset_password } } $user->run_reset; is( $user->password, 'reset', 'password has been reset' ); } 1;