File Coverage

blib/lib/Tree/Authz/Role.pm

Criterion	Covered	Total	%
statement	21	59	35.5
branch	0	12	0.0
condition	0	12	0.0
subroutine	7	19	36.8
pod	8	8	100.0
total	36	110	32.7

package Tree::Authz::Role;
use strict;
use warnings;
use Carp;

use overload '""' => 'name';

# NOTE: if this class ever holds any more data than just its name, it
# should probably be a singleton

=over

=item new( $role, $authz_class )

Represents a role.

=cut

# called by Tree::Authz::role
sub new {
    my ($proto, $role, $authz_class) = @_;

    my $self = [ $role, $authz_class ];

    bless $self, ref( $proto ) || $proto;

    # $self->_init;

    return $self;
}

=item name()

Returns the name of this role.

=item group_name()

DEPRECATED.

Use C instead.

=cut

sub name { $_[0]->[0] }

=item authz

Returns the L subclass used to instantiate this role.

=cut

sub authz { $_[0]->[1] }

sub group_name {
    carp "'group_name' is deprecated - use 'name' instead";
    goto &name;
}

=item list_roles

Returns a list of roles inherited by this role, including this role.

=cut

sub list_roles {
    my ($self) = @_;

    my @my_roles = grep { $self->can( $_ ) } $self->authz->list_roles;

    wantarray ? @my_roles : [ @my_roles ];
}


=item setup_permissions( $cando )

Instance method.

Adds methods to the class representing the role. I<$cando> is a single method
name, or arrayref of method names. No-op methods are added to the class
representing the group:

    my $spies = $authz->role( 'spies' );

    my $cando = [ qw( read_secret wear_disguise ) ];

    $spies->setup_permissions( $cando );

    if ( $spies->can( 'read_secret' ) ) {
        warn 'Compromised!';
    }

    warn 'Trust no-one' if $spies->can( 'wear_disguise' );

=cut

sub setup_permissions {
    my ($self, $cando) = @_;

    croak( 'Nothing to permit' ) unless $cando;
    my $class = ref( $self ) || croak( 'object method called on class name' );

    $class->_setup_perms( $cando );
}

sub _setup_perms {
    my ($class, $cando) = @_;

    my @permits = ref( $cando ) ? @$cando : ( $cando );

    no strict 'refs';
    foreach my $permit ( @permits ) {
        *{"${class}::$permit"} = sub {};
    }
}

=item setup_abilities( $name => $coderef, [ $name2 => $coderef2 ], ... )

Instance method.

Adds methods to the class representing the group. Keys give method names and
values are coderefs that will be installed as methods on the group class:

    my $spies = $authz->get_group( 'spies' );

    my %able = ( read_secret => sub {
                    my ($self, $file) = @_;
                    open( SECRET, $file );
                    local $/;
                    ;
                    },

                 find_moles => sub { ... },

                );

    $spies->setup_abilities( %able );

    if ( $spies->can( 'read_secret' ) ) {
        print $spies->read_secret( '/path/to/secret/file' );
    }

    # or

    if ( my $read = $spies->can( 'read_secret' ) ) {
        print $spies->$read( '/path/to/secret/file' );
    }

    # with an unknown $group
    my $get_secret = $group->can( 'read_secret' )       ||     # spy
                     $group->can( 'steal_document' )    ||     # mole
                     $group->can( 'create_secret' )     ||     # spymaster
                     $group->can( 'do_illicit_thing' )  ||     # politician
                     sub {};                                   # boring life

    my $secret = $group->$get_secret;

=cut

sub setup_abilities {
    my ($self, %code) = @_;

    croak( 'Nothing to set up' ) unless %code;

    my $class = ref( $self ) || croak( 'object method called on class name' );

    $class->_setup_abil( %code );
}

sub _setup_abil {
    my ($class, %code) = @_;

    no strict 'refs';
    foreach my $method ( keys %code ) {
        *{"${class}::$method"} = $code{ $method };
    }
}

=item setup_plugins( $plugins )

Instance method.

Instead of adding a set of coderefs to a group's class, this method adds
a class to the C<@ISA> array of the group's class.

    package My::Spies;

    sub wear_disguise {}

    sub read_secret {
        my ($self, $file) = @_;
        open( SECRET, $file );
        local $/;
        ;
    }

    package main;

    my $spies = $authz->get_group( 'spies' );

    $spies->setup_plugins( 'My::Spies' );

    if ( $spies->can( 'read_secret' ) ) {
        warn 'Compromised!';
        print $spies->read_secret( '/path/to/secret/file' );
    }

    warn 'Trust no-one' if $spies->can( 'wear_disguise' );

=back

=cut


sub setup_plugins {
    my ($self, $plugins) = @_;

    croak( 'Nothing to plug in' ) unless $plugins;

    my $class = ref( $self ) || croak( 'object method called on class name' );

    $class->_setup_plugins( $plugins );
}

sub _setup_plugins {
    my ($class, $plugins) = @_;

    my @plugins = ref( $plugins ) ? @$plugins : ( $plugins );

    no strict 'refs';

    push( @{"${class}::ISA"}, $_ ) for @plugins;
}

1;