view release on metacpan or  search on metacpan

lib/ACL/Lite.pm  view on Meta::CPAN

=cut

our $VERSION = '0.0004';

=head1 SYNOPSIS

    use ACL::Lite;

    $acl = ACL::Lite->new(permissions => 'foo,bar');

    $acl->check('foo');

    if ($ret = $acl->check([qw/baz bar/])) {
        print "Check successful with permission $ret\n";
    }

    unless ($acl->check('baz')) {
        print "Permission denied\n";
    }

    $acl = ACL::Lite->new(uid => 666);

    $acl->check('authenticated');

=head1 DESCRIPTION

C<ACL::Lite> is a simple permission checker without any prerequisites.

C<ACL> stands for "Access Control Lists".

=head2 DEFAULT PERMISSION

The default permission depends on whether you pass a C<uid> (authenticated)
or not (anonymous).

=head1 CONSTRUCTOR

=head2 new

Creates an ACL::Lite object by passing the following parameters:

=over 4

=item uid

User identifier for authenticated users.

=item permissions

Granted permissions.

=item separator

Separator used to parse permission strings. Defaults to C<,>.

=back

=cut

sub new {
	my ($class, $self, $type, %args);
	
	$class = shift;

	%args = @_;
	
	$self = {separator => $args{separator} || ',',
			 permissions => {},
			 uid => $args{uid},
			 volatile => 0};
	
	bless $self, $class;
	
	if (exists $args{permissions}) {
		$type = ref($args{permissions});

		if ($type eq 'ARRAY') {
			for my $perm (@{$args{permissions}}) {
				$self->{permissions}->{$perm} = 1;
			}
		}
		elsif ($type eq 'CODE') {
			$self->{volatile} = 1;
			$self->{sub} = $args{permissions};
		}
		elsif (defined $args{permissions}) {
			my @perms;

			for my $perm (split(/$self->{separator}/, $args{permissions})) {
				$perm =~ s/^\s+//;
				$perm =~ s/\s+$//;
				next unless length($perm);

				$self->{permissions}->{$perm} = 1;
			}
		}
	}

    # add default permissions
    if ($self->{uid}) {
        $self->{permissions}->{authenticated} = 1;
    }
    else {
        $self->{permissions}->{anonymous} = 1;
    }

	return $self;
}

=head2 check $permissions, $uid

Checks whether any of the permissions in $permissions is granted.
Returns first permission which grants access.

=cut

sub check {
	my ($self, $permissions, $uid) = @_;
	my (@check, $user_permissions);

	if (ref($permissions) eq 'ARRAY') {
		@check = @$permissions;
	}
	else {
		@check = ($permissions);
	}

	if ($uid && $uid ne $self->{uid}) {
		# mismatch on user identifier
		return;
	}

    $user_permissions = $self->permissions;

	for my $perm (@check) {
		if (exists $user_permissions->{$perm}) {
			return $perm;
		}
	}

	return;
}