Abilities

 view release on metacpan or  search on metacpan

lib/Abilities.pm  view on Meta::CPAN

Classes that consume this role will have the following methods available
to them:

=head2 can_perform( $action, [ $constraint ] )

Receives the name of an action, and possibly a constraint, and returns a true
value if the user/role can perform the provided action.

=cut

sub can_perform {
	my ($self, $action, $constraint) = @_;

	# a super-user/super-role can do whatever they want
	return 1 if $self->is_super;

	# return false if user/role doesn't have that ability
	return unless $self->abilities->{$action};

	# user/role has ability, but is there a constraint?
	if ($constraint && $constraint ne '_all_') {

lib/Abilities.pm  view on Meta::CPAN

=head2 assigned_role( $role_name )

This method receives a role name and returns a true value if the user/role
is a direct member of the provided role. Only direct membership is checked,
so the user/role must be specifically assigned to the provided role, and
not to a role that inherits from that role (see L</"does_role( $role )">
instead).

=cut

sub assigned_role {
	my ($self, $role) = @_;

	return unless $role;

	foreach ($self->roles) {
		return 1 if $_ eq $role;
	}

	return;
}

lib/Abilities.pm  view on Meta::CPAN

=head2 does_role( $role_name )

Receives the name of a role, and returns a true value if the user/role
inherits the abilities of the provided role. This method takes inheritance
into account, so if a user was directly assigned to the 'admins' role,
and the 'admins' role inherits from the 'devs' role, then C<does_role('devs')>
will return true for that user (while C<assigned_role('devs')> returns false).

=cut

sub does_role {
	my ($self, $role) = @_;

	return unless $role;

	foreach (map([$_, $self->get_role($_)], $self->roles)) {
		return 1 if $_->[0] eq $role || $_->[1]->does_role($role);
	}

	return;
}

lib/Abilities.pm  view on Meta::CPAN

=head2 abilities()

Returns a hash reference of all the abilities a user/role object can
perform, after consolidating abilities inherited from roles (including
recursively) and directly granted. Keys in the hash-ref will be names
of actions, values will be 1 (for yes/no actions) or a single-item array-ref
with the name of a constraint (for constrained actions).

=cut

sub abilities {
	my $self = shift;

	my $abilities = {};

	# load direct actions granted to this user/role
	foreach ($self->actions) {
		# is this action constrained/scoped?
		unless (ref $_) {
			$abilities->{$_} = 1;
		} elsif (ref $_ eq 'ARRAY' && scalar @$_ == 2) {

lib/Abilities/Features.pm  view on Meta::CPAN

Classes that consume this role will have the following methods provided
to them:

=head2 has_feature( $feature_name, [ $constraint ] )

Receives the name of a feature, and possibly a constraint, and returns a
true value if the customer/plan has that feature, false value otherwise.

=cut

sub has_feature {
	my ($self, $feature, $constraint) = @_;

	# return false if customer/plan does not have that feature
	return unless $self->available_features->{$feature};

	# customer/plan has feature, but is there a constraint?
	if ($constraint) {
		# return true if customer/plan's feature is not constrained
		return 1 if !ref $self->available_features->{$feature};
		

lib/Abilities/Features.pm  view on Meta::CPAN

=head2 in_plan( $plan_name )

Receives the name of plan and returns a true value if the user/customer
is a direct member of the provided plan(s). Only direct association is
checked, so the user/customer must be specifically assigned to that plan,
and not to a plan that inherits from that plan (see L</"inherits_plan( $plan_name )">
instead).

=cut

sub in_plan {
	my ($self, $plan) = @_;

	return unless $plan;

	foreach ($self->plans) {
		return 1 if $_ eq $plan;
	}

	return;
}

=head2 inherits_plan( $plan_name )

Returns a true value if the customer/plan inherits the features of
the provided plan(s). If a customer belongs to the 'premium' plan, and
the 'premium' plan inherits from the 'basic' plan, then C<inherits_plan('basic')>
will be true for that customer, while C<in_plan('basic')> will be false.

=cut

sub inherits_plan {
	my ($self, $plan) = @_;

	return unless $plan;

	foreach (map([$_, $self->get_plan($_)], $self->plans)) {
		return 1 if $_->[0] eq $plan || $_->[1]->inherits_plan($plan);
	}

	return;
}

lib/Abilities/Features.pm  view on Meta::CPAN

=head2 available_features

Returns a hash-ref of all features available to a customer/plan object, after
consolidating features from inherited plans (recursively) and directly granted.
Keys of this hash-ref will be the names of the features, values will either be
1 (for yes/no features), or a single-item array-ref with a name of a constraint
(for constrained features).

=cut

sub available_features {
	my $self = shift;

	my $features = {};

	# load direct features granted to this customer/plan
	foreach ($self->features) {
		# is this features constrained?
		unless (ref $_) {
			$features->{$_} = 1;
		} elsif (ref $_ eq 'ARRAY' && scalar @$_ == 2) {

t/lib/TestCustomer.pm  view on Meta::CPAN

use Moo;
use namespace::autoclean;

has 'name' => (
	is => 'ro',
	required => 1
);

has 'features' => (
	is => 'ro',
	default => sub { [] }
);

has 'plans' => (
	is => 'ro',
	default => sub { [] }
);

has 'mg' => (
	is => 'ro',
	required => 1,
);

with 'Abilities::Features';

sub get_plan {
	my ($self, $plan) = @_;

	return $self->mg->{$plan};
}

around qw/features plans/ => sub {
	my ($orig, $self) = @_;

	return @{$self->$orig || []};
};

1;

t/lib/TestManager.pm  view on Meta::CPAN

package TestManager;

use warnings;
use strict;

sub new { bless {}, shift }

sub add_objects {
	my $self = shift;

	foreach (@_) {
		$self->{$_->name} = $_;
	}

	return $self;
}

1;

t/lib/TestPlan.pm  view on Meta::CPAN

use Moo;
use namespace::autoclean;

has 'name' => (
	is => 'ro',
	required => 1
);

has 'features' => (
	is => 'ro',
	default => sub { [] }
);

has 'plans' => (
	is => 'ro',
	default => sub { [] }
);

has 'mg' => (
	is => 'ro',
	required => 1,
);

with 'Abilities::Features';

sub get_plan {
	my ($self, $plan) = @_;

	return $self->mg->{$plan};
}

around qw/features plans/ => sub {
	my ($orig, $self) = @_;

	return @{$self->$orig || []};
};

1;

t/lib/TestRole.pm  view on Meta::CPAN

use Moo;
use namespace::autoclean;

has 'name' => (
	is => 'ro',
	required => 1
);

has 'actions' => (
	is => 'ro',
	default => sub { [] }
);

has 'roles' => (
	is => 'ro',
	default => sub { [] }
);

has 'is_super' => (
	is => 'ro',
	default => sub { 0 }
);

has 'mg' => (
	is => 'ro',
	required => 1,
);

with 'Abilities';

sub get_role {
	my ($self, $role) = @_;

	return $self->mg->{$role};
}

around qw/actions roles/ => sub {
	my ($orig, $self) = @_;

	return @{$self->$orig || []};
};

1;

t/lib/TestUser.pm  view on Meta::CPAN

use Moo;
use namespace::autoclean;

has 'name' => (
	is => 'ro',
	required => 1
);

has 'actions' => (
	is => 'ro',
	default => sub { [] }
);

has 'roles' => (
	is => 'ro',
	default => sub { [] }
);

has 'is_super' => (
	is => 'ro',
	default => sub { 0 }
);

has 'mg' => (
	is => 'ro',
	required => 1,
);

with 'Abilities';

sub get_role {
	my ($self, $role) = @_;

	return $self->mg->{$role};
}

around qw/actions roles/ => sub {
	my ($orig, $self) = @_;

	return @{$self->$orig || []};
};

1;