source: LATMOS-Accounts/t/21_acls.t @ 490

use strict;
use warnings;
use Test::More tests => 14;

use_ok('LATMOS::Accounts::Acls');

{
    ok(my $acl = LATMOS::Accounts::Acls::acl->new('user.uid', [ 'user1: read' ]),
        "can create single acl");
    is($acl->match(fakeobject->new('user', 'user1'), 'uid', 'r', 'user1'), 1, "acl match");
    is($acl->match(fakeobject->new('user', 'user2'), 'uid', 'w', 'user1') || 0, 0, "acl match");
}

{
    ok(my $acls = LATMOS::Accounts::Acls->new, "Can create new acls objects");
    ok($acls->add('user.uid', [ 'user1: read' ]), "Can add new acl");
}

{
    ok(my $acls = LATMOS::Accounts::Acls->new('testdata/acls1'),
        "Can create new acls objects from file");
    # now testing...
    is(
        $acls->check(fakeobject->new('user', 'user1'), 'uid', 'r', 'user1'),
        1, "user can read uid");
    is(
        $acls->check(fakeobject->new('user', 'user1'), 'userPassword', 'r', 'user1'),
        0, "user cannot read userPassword");
    is(
        $acls->check(fakeobject->new('user', 'user1'), 'uid', 'w', 'user1'),
        0, "user cannot write uid");
    is(
        $acls->check(fakeobject->new('user', 'user1'), 'givenName', 'w', 'user1'),
        1, "user can write givenName");
    is(
        $acls->check(fakeobject->new('user', 'user1'), 'uid', 'w',
            'user1', [ 'admin' ]), 0, "user cannot write user attribute");
    is(
        $acls->check(fakeobject->new('group', 'group1'), 'uid', 'w',
            'user1', [ 'admin' ]), 1, "user can write group attribute");
    is(
        $acls->check('user', 'CREATE', 'w', 'user1', [ 'admin' ]), 1,
            "user can create a new user");
}


# A fake object to test only ACLs
package fakeobject;

sub new {
    my ($class, $type, $id) = @_;
    bless({type => $type, id => $id}, $class);
}

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

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

sub _get_c_field {
    $_[0]->{id}
}