ACL-Lite

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

Revision history for ACL::Lite

0.0004 Sat Dec 14 10:49:04 2013 CET

    [BUG FIXES]

    * Prevent Perl warning on undefined permissions parameter.

0.0003 Wed Dec  4 13:13:00 2013 CET

    [API CHANGES]

    * Add default permissions ("authenticated" or "anonymous") depending
      whether you pass uid or not.

0.0002 Wed May 22 15:57:12 2013 CEST

    [BUG FIXES]

    * Execute POD tests only during release testing.

    [ENHANCEMENTS]

    * Add permissions method to retrieve list or hash reference of
      permissions.

0.0001 Thu Sep 15 22:29:36 2011 CEST
       
    * Initial release.


MANIFEST  view on Meta::CPAN

Changes
ignore.txt
lib/ACL/Lite.pm
Makefile.PL
MANIFEST			This list of files
MANIFEST.SKIP
README
t/00-load.t
t/01-simple.t
t/boilerplate.t
t/manifest.t
t/pod-coverage.t
t/pod.t
META.yml                                 Module YAML meta-data (added by MakeMaker)
META.json                                Module JSON meta-data (added by MakeMaker)

MANIFEST.SKIP  view on Meta::CPAN

.git
\.bak$
\.old$

META.json  view on Meta::CPAN

{
   "abstract" : "Liteweight and flexible ACL checks",
   "author" : [
      "Stefan Hornburg (Racke) <racke@linuxia.de>"
   ],
   "dynamic_config" : 1,
   "generated_by" : "ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.120921",
   "license" : [
      "perl_5"
   ],
   "meta-spec" : {
      "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
      "version" : "2"
   },
   "name" : "ACL-Lite",
   "no_index" : {
      "directory" : [
         "t",
         "inc"
      ]
   },
   "prereqs" : {
      "build" : {
         "requires" : {
            "ExtUtils::MakeMaker" : "0"
         }
      },
      "configure" : {
         "requires" : {
            "ExtUtils::MakeMaker" : "0"
         }
      },
      "runtime" : {
         "requires" : {
            "Test::More" : "0"
         }
      }
   },
   "release_status" : "stable",
   "version" : "0.0004"
}

META.yml  view on Meta::CPAN

---
abstract: 'Liteweight and flexible ACL checks'
author:
  - 'Stefan Hornburg (Racke) <racke@linuxia.de>'
build_requires:
  ExtUtils::MakeMaker: 0
configure_requires:
  ExtUtils::MakeMaker: 0
dynamic_config: 1
generated_by: 'ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.120921'
license: perl
meta-spec:
  url: http://module-build.sourceforge.net/META-spec-v1.4.html
  version: 1.4
name: ACL-Lite
no_index:
  directory:
    - t
    - inc
requires:
  Test::More: 0
version: 0.0004

Makefile.PL  view on Meta::CPAN

use 5.006;
use strict;
use warnings;
use ExtUtils::MakeMaker;

WriteMakefile(
    NAME                => 'ACL::Lite',
    AUTHOR              => q{Stefan Hornburg (Racke) <racke@linuxia.de>},
    VERSION_FROM        => 'lib/ACL/Lite.pm',
    ABSTRACT_FROM       => 'lib/ACL/Lite.pm',
    ($ExtUtils::MakeMaker::VERSION >= 6.3002
      ? ('LICENSE'=> 'perl')
      : ()),
    PL_FILES            => {},
    PREREQ_PM => {
        'Test::More' => 0,
    },
    dist                => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
    clean               => { FILES => 'ACL-Lite-*' },
);

README  view on Meta::CPAN

NAME
    ACL::Lite - Liteweight and flexible ACL checks

VERSION
    Version 0.0004

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');

DESCRIPTION
    `ACL::Lite' is a simple permission checker without any prerequisites.

    `ACL' stands for "Access Control Lists".

  DEFAULT PERMISSION
    The default permission depends on whether you pass a `uid'
    (authenticated) or not (anonymous).

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

    uid User identifier for authenticated users.

    permissions
        Granted permissions.

    separator
        Separator used to parse permission strings. Defaults to `,'.

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

  permissions
    Returns permissions as hash reference:

        $perms = $acl->permissions;

    Returns permissions as list:

        @perms = $acl->permissions;

CAVEATS
    Please anticipate API changes in this early state of development.

AUTHOR
    Stefan Hornburg (Racke), `racke@linuxia.de'

BUGS
    Please report any bugs or feature requests to `bug-acl-lite at
    rt.cpan.org', or through the web interface at
    http://rt.cpan.org/NoAuth/ReportBug.html?Queue=ACL-Lite. I will be
    notified, and then you'll automatically be notified of progress on your
    bug as I make changes.

SUPPORT
    You can find documentation for this module with the perldoc command.

        perldoc ACL::Lite

    You can also look for information at:

    * RT: CPAN's request tracker (report bugs here)
        http://rt.cpan.org/NoAuth/Bugs.html?Dist=ACL-Lite

    * AnnoCPAN: Annotated CPAN documentation
        http://annocpan.org/dist/ACL-Lite

    * CPAN Ratings
        http://cpanratings.perl.org/d/ACL-Lite

    * Search CPAN
        http://search.cpan.org/dist/ACL-Lite/

ACKNOWLEDGEMENTS
LICENSE AND COPYRIGHT
    Copyright 2011-2013 Stefan Hornburg (Racke).

    This program is free software; you can redistribute it and/or modify it
    under the terms of either: the GNU General Public License as published
    by the Free Software Foundation; or the Artistic License.

    See http://dev.perl.org/licenses/ for more information.

ignore.txt  view on Meta::CPAN

blib*
Makefile
Makefile.old
Build
Build.bat
_build*
pm_to_blib*
*.tar.gz
.lwpcookies
cover_db
pod2htm*.tmp
ACL-Lite-*

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

package ACL::Lite;

use 5.006;
use strict;
use warnings;

=head1 NAME

ACL::Lite - Liteweight and flexible ACL checks

=head1 VERSION

Version 0.0004

=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;
}

=head2 permissions

Returns permissions as hash reference:

    $perms = $acl->permissions;

Returns permissions as list:

    @perms = $acl->permissions;

=cut

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

    if ($self->{volatile}) {
        $self->{permissions} = $self->{sub}->();
    }

    if (wantarray) {
        return keys %{$self->{permissions}};
    }

    return $self->{permissions};
}

=head1 CAVEATS

Please anticipate API changes in this early state of development.

=head1 AUTHOR

Stefan Hornburg (Racke), C<racke@linuxia.de>

=head1 BUGS

Please report any bugs or feature requests to C<bug-acl-lite at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=ACL-Lite>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc ACL::Lite


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=ACL-Lite>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/ACL-Lite>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/ACL-Lite>

=item * Search CPAN

L<http://search.cpan.org/dist/ACL-Lite/>

=back


=head1 ACKNOWLEDGEMENTS


=head1 LICENSE AND COPYRIGHT

Copyright 2011-2013 Stefan Hornburg (Racke).

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.


=cut

1; # End of ACL::Lite

t/00-load.t  view on Meta::CPAN

#!perl -T

use Test::More tests => 1;

BEGIN {
    use_ok( 'ACL::Lite' ) || print "Bail out!\n";
}

diag( "Testing ACL::Lite $ACL::Lite::VERSION, Perl $], $^X" );

t/01-simple.t  view on Meta::CPAN

#! perl -T

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

use ACL::Lite;

my ($perms, $acl, @parr, $pref, $ret);

# permissions in a string
$perms = 'foo,bar';

$acl = ACL::Lite->new(permissions => $perms);

isa_ok($acl, 'ACL::Lite');

ok($acl->check('foo') eq 'foo');
ok($acl->check('bar') eq 'bar');
ok($acl->check(['foo', 'bar']) eq 'foo');
ok(! defined($acl->check('baz')));

test_return_of_permissions($acl);

# permissions in an array reference
$perms = [qw/foo bar/];

$acl = ACL::Lite->new(permissions => $perms);

isa_ok($acl, 'ACL::Lite');

ok($acl->check('foo') eq 'foo');
ok($acl->check('bar') eq 'bar');
ok($acl->check(['foo', 'bar']) eq 'foo');
ok(! defined($acl->check('baz')));

test_return_of_permissions($acl);

# permissions from a provider
$perms = sub {my %p = (anonymous => 1, foo => 1, bar => 1); return \%p};

$acl = ACL::Lite->new(permissions => $perms);

isa_ok($acl, 'ACL::Lite');

ok($acl->check('foo') eq 'foo');
ok($acl->check('bar') eq 'bar');
ok($acl->check(['foo', 'bar']) eq 'foo');
ok(! defined($acl->check('baz')));

test_return_of_permissions($acl);

# anonymous and authenticated permissions
$acl = ACL::Lite->new(permissions => '', uid => undef);

isa_ok($acl, 'ACL::Lite');

$ret = $acl->check('anonymous');
ok(defined $ret && $ret eq 'anonymous', 'Check for anonymous permission of anonymous user.')
    || diag "Return value: $ret:";

$ret = $acl->check('authenticated');
ok(! defined($ret), 'Check for authenticated permission of anonymous user.')
    || diag "Return value: $ret.";

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

isa_ok($acl, 'ACL::Lite');

$ret = $acl->check('authenticated');
ok(defined $ret && $ret eq 'authenticated', 'Check for authenticated permission of authenticated user.')
    || diag "Return value: $ret:";

$ret = $acl->check('anonymous');
ok(! defined($ret), 'Check for anonymous permission of authenticated user.')
    || diag "Return value: $ret.";

sub test_return_of_permissions {
    my $acl = shift;

    @parr = $acl->permissions;

    is_deeply([sort @parr], ['anonymous', 'bar', 'foo'], "Test return value of permissions method (array).");

    $pref = $acl->permissions;

    is_deeply([sort keys %$pref], ['anonymous', 'bar', 'foo'], "Test return value of permissions method (hash reference).");
}

t/boilerplate.t  view on Meta::CPAN

#!perl -T

use 5.006;
use strict;
use warnings;
use Test::More tests => 3;

sub not_in_file_ok {
    my ($filename, %regex) = @_;
    open( my $fh, '<', $filename )
        or die "couldn't open $filename for reading: $!";

    my %violated;

    while (my $line = <$fh>) {
        while (my ($desc, $regex) = each %regex) {
            if ($line =~ $regex) {
                push @{$violated{$desc}||=[]}, $.;
            }
        }
    }

    if (%violated) {
        fail("$filename contains boilerplate text");
        diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
    } else {
        pass("$filename contains no boilerplate text");
    }
}

sub module_boilerplate_ok {
    my ($module) = @_;
    not_in_file_ok($module =>
        'the great new $MODULENAME'   => qr/ - The great new /,
        'boilerplate description'     => qr/Quick summary of what the module/,
        'stub function definition'    => qr/function[12]/,
    );
}

TODO: {
  local $TODO = "Need to replace the boilerplate text";

  not_in_file_ok(README =>
    "The README is used..."       => qr/The README is used/,
    "'version information here'"  => qr/to provide version information/,
  );

  not_in_file_ok(Changes =>
    "placeholder date/time"       => qr(Date/time)
  );

  module_boilerplate_ok('lib/ACL/Lite.pm');


}

t/manifest.t  view on Meta::CPAN

#!perl -T

use strict;
use warnings;
use Test::More;

unless ( $ENV{RELEASE_TESTING} ) {
    plan( skip_all => "Author tests not required for installation" );
}

eval "use Test::CheckManifest 0.9";
plan skip_all => "Test::CheckManifest 0.9 required" if $@;
ok_manifest();

t/pod-coverage.t  view on Meta::CPAN

use strict;
use warnings;
use Test::More;

unless ( $ENV{RELEASE_TESTING} ) {
    plan( skip_all => "Author tests not required for installation" );
}

# Ensure a recent version of Test::Pod::Coverage
my $min_tpc = 1.08;
eval "use Test::Pod::Coverage $min_tpc";
plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage"
    if $@;

# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
# but older versions don't recognize some common documentation styles
my $min_pc = 0.18;
eval "use Pod::Coverage $min_pc";
plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage"
    if $@;

all_pod_coverage_ok();

t/pod.t  view on Meta::CPAN

#!perl -T

use strict;
use warnings;
use Test::More;

unless ( $ENV{RELEASE_TESTING} ) {
    plan( skip_all => "Author tests not required for installation" );
}

# Ensure a recent version of Test::Pod
my $min_tp = 1.22;
eval "use Test::Pod $min_tp";
plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;

all_pod_files_ok();

 view all matches for this distribution
 view release on metacpan -  search on metacpan

( run in 0.569 second using v1.00-cache-2.02-grep-82fe00e-cpan-503542c4f10 )