File Coverage

blib/lib/RBAC/Tiny.pm
Criterion Covered Total %
statement 42 42 100.0
branch 15 16 93.7
condition 8 10 80.0
subroutine 10 10 100.0
pod 4 4 100.0
total 79 82 96.3


line stmt bran cond sub pod time code
1             ## no critic
2             package RBAC::Tiny;
3             $RBAC::Tiny::VERSION = '0.001';
4             ## use critic
5             # ABSTRACT: Tiny Role-Based Access Control (RBAC) implementation
6 6     6   142340 use strict;
  6         15  
  6         157  
7 6     6   30 use warnings;
  6         13  
  6         156  
8 6     6   32 use Carp;
  6         13  
  6         472  
9 6     6   34 use List::Util;
  6         15  
  6         3568  
10              
11             sub new {
12 10     10 1 8274 my ( $class, %args ) = @_;
13 10 100       220 my $raw_roles = $args{'roles'}
14             or croak "'roles' attribute required";
15              
16 9         44 return bless { raw_roles => $raw_roles }, $class;
17             }
18              
19             sub role {
20 24     24 1 559 my ( $self, $role, $cache ) = @_;
21 24   100     99 $cache ||= {};
22 24   100     176 return $self->{'role'}{$role} ||= $self->_build_role( $role, $cache );
23             }
24              
25             sub _build_role {
26 16     16   29 my ( $self, $role, $cache ) = @_;
27 16 100       168 my $raw = $self->{'raw_roles'}{$role}
28             or croak "No data provided for role '$role'";
29              
30 15 100       359 $cache->{$role}
31             and croak("Circular dependency detected in '$role' and '$cache->{$role}'");
32              
33 13         19 my @cans;
34             # add all cans from parents, recursively
35 13 100       19 foreach my $from ( @{ $raw->{'all_from'} || [] } ) {
  13         73  
36 9 100       148 $self->{'raw_roles'}{$from}
37             or croak("Role '$from' does not exist but used by '$role'");
38              
39 8         26 $cache->{$role} = $from;
40 8         30 my $role = $self->role($from, $cache);
41 5 50       11 push @cans, @{ $role->{'can'} || [] };
  5         30  
42             }
43              
44             # add our own cans
45 9 100       18 push @cans, @{ $raw->{'can'} || [] };
  9         40  
46              
47 9         15 my %can_cache;
48 9 100       13 my %except = map +( $_ => 1 ), @{ $raw->{'except'} || [] };
  9         64  
49             return {
50             can => [
51             grep +(
52 9   66     178 !$except{$_} and !$can_cache{$_}++
53             ), @cans
54             ],
55             };
56             }
57              
58             sub can_role {
59 6     6 1 15 my ( $self, $role, $permission ) = @_;
60             return List::Util::first {
61 15     15   41 $_ eq $permission
62 6         22 } @{ $self->role($role)->{'can'} };
  6         13  
63             }
64              
65             sub roles {
66 5     5 1 875 my $self = shift;
67             return $self->{'roles'} ||= +{
68 5   50     34 map +( $_ => $self->role($_) ), keys %{ $self->{'raw_roles'} }
  5         43  
69             };
70             }
71              
72             1;
73              
74             __END__