Permalink
Browse files

here's... JOHNNY

  • Loading branch information...
xsawyerx committed Sep 8, 2013
0 parents commit 2edd3aa5c116496a6c30f75ce4e3e822022ddfbf
Showing with 1,092 additions and 0 deletions.
  1. +484 −0 lib/Authorize/Rule.pm
  2. +85 −0 t/callback.t
  3. +32 −0 t/eg1.t
  4. +57 −0 t/eg2.t
  5. +52 −0 t/eg3.t
  6. +50 −0 t/eg4.t
  7. +50 −0 t/eg5.t
  8. +51 −0 t/eg6.t
  9. +50 −0 t/eg7.t
  10. +105 −0 t/example_perms.t
  11. +76 −0 t/synopsis.t

Large diffs are not rendered by default.

Oops, something went wrong.
@@ -0,0 +1,85 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+ok( 1, 'Callback support is not implemented yet' );
+
+# FIXME TODO XXX callback support check
+
+__END__
+
+use Test::More tests => 18;
+use Authorize::Rule;
+
+my $auth = Authorize::Rule->new(
+ default => -1,
+ rules => {
+ cats => [
+ deny => {
+ 'living room' => {
+ present => [ 'John', 'Jill' ]
+ }
+ },
+
+ allow => '*',
+ ]
+ },
+);
+
+isa_ok( $auth, 'Authorize::Rule' );
+can_ok( $auth, 'check' );
+
+# situations:
+# - john is in the house
+# - only john is in the house
+# - jill is in the house
+# - only jill is in the house
+# - both are in the house
+# - none of them are in the house
+# - no one is in the house
+
+my @tests = (
+ # result, room, people in the house
+ [ 0, 'living room', qw<John Jeff> ],
+ [ 0, 'living room', qw<John> ],
+ [ 0, 'living room', qw<Jill Jeff> ],
+ [ 0, 'living room', qw<Jill> ],
+ [ 0, 'living room', qw<Jill John> ],
+ [ 0, 'living room', qw<Jill John Jeff> ],
+ [ 1, 'living room', qw<Jeff Joan> ],
+ [ 1, 'living room', qw<> ],
+
+ [ 1, 'bedroom', qw<John Jeff> ],
+ [ 1, 'bedroom', qw<John> ],
+ [ 1, 'bedroom', qw<Jill Jeff> ],
+ [ 1, 'bedroom', qw<Jill> ],
+ [ 1, 'bedroom', qw<Jill John> ],
+ [ 1, 'bedroom', qw<Jill John Jeff> ],
+ [ 1, 'bedroom', qw<Jeff Joan> ],
+ [ 1, 'bedroom', qw<> ],
+);
+
+foreach my $test (@tests) {
+ my ( $success, $resource, @in_the_house ) = @{$test};
+ my $entity = 'cats';
+ my $description = "$entity " . ( $success ? 'can' : 'cannot' ) .
+ " access $resource" .
+ ( @in_the_house ?
+ " with " . join ', ', @in_the_house
+ : '' );
+
+ my $cb = sub {
+ my $prm = shift;
+ grep { $_ eq $prm->{'present'} } @in_the_house;
+ };
+
+ cmp_ok(
+ $auth->check( $entity => $resource, $cb ),
+ '==',
+ $success,
+ $description,
+ );
+}
+
32 t/eg1.t
@@ -0,0 +1,32 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 4;
+use Authorize::Rule;
+
+my $auth = Authorize::Rule->new(
+ default => -1,
+ rules => {
+ cats => [ allow => '*' ]
+ }
+);
+
+isa_ok( $auth, 'Authorize::Rule' );
+can_ok( $auth, 'check' );
+
+cmp_ok(
+ $auth->check( cats => 'kitchen' ),
+ '==',
+ 1,
+ 'Cats can go in the kitchen',
+);
+
+cmp_ok(
+ $auth->check( cats => 'bedroom' ),
+ '==',
+ 1,
+ 'Cats can go in the bedroom',
+);
+
57 t/eg2.t
@@ -0,0 +1,57 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 7;
+use Authorize::Rule;
+
+my $auth = Authorize::Rule->new(
+ default => -1,
+ rules => {
+ cats => [ allow => '*' ],
+ dogs => [
+ deny => ['table', 'laundry room'],
+ allow => '*',
+ ],
+ }
+);
+
+isa_ok( $auth, 'Authorize::Rule' );
+can_ok( $auth, 'check' );
+
+cmp_ok(
+ $auth->check( cats => 'kitchen' ),
+ '==',
+ 1,
+ 'Cats can go in the kitchen',
+);
+
+cmp_ok(
+ $auth->check( cats => 'bedroom' ),
+ '==',
+ 1,
+ 'Cats can go in the bedroom',
+);
+
+cmp_ok(
+ $auth->check( dogs => 'table' ),
+ '==',
+ 0,
+ 'Dogs cannot go on the table',
+);
+
+cmp_ok(
+ $auth->check( dogs => 'laundry room' ),
+ '==',
+ 0,
+ 'Dogs cannot go on the table',
+);
+
+cmp_ok(
+ $auth->check( dogs => 'bedroom' ),
+ '==',
+ 1,
+ 'Dogs can go in the bedroom',
+);
+
52 t/eg3.t
@@ -0,0 +1,52 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 11;
+use Authorize::Rule;
+
+my $auth = Authorize::Rule->new(
+ default => -1,
+ rules => {
+ cats => [ deny => ['bedroom'], allow => '*' ],
+ dogs => [
+ deny => [ 'table', 'laundry room', 'bedroom' ],
+ allow => '*',
+ ],
+
+ kitties => [
+ allow => ['bedroom'],
+ deny => '*',
+ ],
+ }
+);
+
+isa_ok( $auth, 'Authorize::Rule' );
+can_ok( $auth, 'check' );
+
+my @tests = (
+ [ qw<1 cats kitchen> ],
+ [ qw<0 cats bedroom> ],
+ [ qw<1 dogs kitchen> ],
+ [ qw<0 dogs table> ],
+ [ qw<0 dogs bedroom> ],
+ [ qw<0 dogs>, 'laundry room' ],
+ [ qw<0 kitties kitchen> ],
+ [ qw<0 kitties table> ],
+ [ qw<1 kitties bedroom> ],
+);
+
+foreach my $test (@tests) {
+ my ( $success, $entity, $resource ) = @{$test};
+ my $description = "$entity " . ( $success ? 'can' : 'cannot' ) .
+ " access $resource";
+
+ cmp_ok(
+ $auth->check( $entity => $resource ),
+ '==',
+ $success,
+ $description,
+ );
+}
+
50 t/eg4.t
@@ -0,0 +1,50 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 10;
+use Authorize::Rule;
+
+my $auth = Authorize::Rule->new(
+ default => -1,
+ rules => {
+ CEO => [
+ deny => ['Payroll'],
+ allow => '*',
+ ],
+
+ support => [
+ allow => [ 'UserPreferences', 'UserComplaintHistory' ],
+ deny => '*',
+ ],
+ }
+);
+
+isa_ok( $auth, 'Authorize::Rule' );
+can_ok( $auth, 'check' );
+
+my @tests = (
+ [ qw<0 CEO Payroll> ],
+ [ qw<1 CEO UserPreferences> ],
+ [ qw<1 CEO UserComplaintHistory> ],
+ [ qw<1 CEO SecretStuff> ],
+ [ qw<0 support Payroll> ],
+ [ qw<1 support UserPreferences> ],
+ [ qw<1 support UserComplaintHistory> ],
+ [ qw<0 support SecretStuff> ],
+);
+
+foreach my $test (@tests) {
+ my ( $success, $entity, $resource ) = @{$test};
+ my $description = "$entity " . ( $success ? 'can' : 'cannot' ) .
+ " access $resource";
+
+ cmp_ok(
+ $auth->check( $entity => $resource ),
+ '==',
+ $success,
+ $description,
+ );
+}
+
50 t/eg5.t
@@ -0,0 +1,50 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 6;
+use Authorize::Rule;
+use Data::Dumper;
+
+$Data::Dumper::Terse = 1;
+$Data::Dumper::Indent = 0;
+
+my $auth = Authorize::Rule->new(
+ default => -1,
+ rules => {
+ dogs => [
+ allow => {
+ table => { owner => ['someone-else'] }
+ },
+
+ deny => ['table'],
+ allow => '*',
+ ]
+ },
+);
+
+isa_ok( $auth, 'Authorize::Rule' );
+can_ok( $auth, 'check' );
+
+my @tests = (
+ [ qw<1 dogs table>, { owner => 'someone-else' } ],
+ [ qw<0 dogs table>, { owner => 'me' } ],
+ [ qw<0 dogs table> ],
+ [ qw<1 dogs kitchen> ],
+);
+
+foreach my $test (@tests) {
+ my ( $success, $entity, $resource, $params ) = @{$test};
+ my $description = "$entity " . ( $success ? 'can' : 'cannot' ) .
+ " access $resource" .
+ ( $params ? ', ' . Dumper($params) : '' );
+
+ cmp_ok(
+ $auth->check( $entity => $resource, $params ),
+ '==',
+ $success,
+ $description,
+ );
+}
+
51 t/eg6.t
@@ -0,0 +1,51 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 7;
+use Authorize::Rule;
+use Data::Dumper;
+
+$Data::Dumper::Terse = 1;
+$Data::Dumper::Indent = 0;
+
+my $auth = Authorize::Rule->new(
+ default => -1,
+ rules => {
+ dogs => [
+ allow => {
+ table => { owner => ['jim', 'john'] }
+ },
+
+ deny => ['table'],
+ allow => '*',
+ ]
+ },
+);
+
+isa_ok( $auth, 'Authorize::Rule' );
+can_ok( $auth, 'check' );
+
+my @tests = (
+ [ qw<1 dogs table>, { owner => 'jim' } ],
+ [ qw<1 dogs table>, { owner => 'john' } ],
+ [ qw<0 dogs table>, { owner => 'me' } ],
+ [ qw<0 dogs table> ],
+ [ qw<1 dogs kitchen> ],
+);
+
+foreach my $test (@tests) {
+ my ( $success, $entity, $resource, $params ) = @{$test};
+ my $description = "$entity " . ( $success ? 'can' : 'cannot' ) .
+ " access $resource" .
+ ( $params ? ', ' . Dumper($params) : '' );
+
+ cmp_ok(
+ $auth->check( $entity => $resource, $params ),
+ '==',
+ $success,
+ $description,
+ );
+}
+
Oops, something went wrong.

0 comments on commit 2edd3aa

Please sign in to comment.