lib/Catalyst/Plugin/Authorization/ACL/Paranoid/Engine.pm

   1 package Catalyst::Plugin::Authorization::ACL::Paranoid::Engine;
   2
   3 use strict;
   4 use warnings;
   5
   6 sub new {
   7     my ( $class, $c ) = @_;
   8
   9     my $self = bless { rules => {} }, $class;
  10
  11     return $self;
  12 }
  13
  14 sub rules {
  15     my ( $self, $rules ) = @_;
  16
  17     $self->{ rules } = {};
  18
  19     while ( my ( $action, $check ) = each %$rules ) {
  20         $action =~ s/^\///o unless $action eq '/';
  21
  22         $self->{ rules }->{ $action } =
  23           ref $check eq 'CODE' ? $check : sub { $check }
  24     }
  25 }
  26
  27 sub is_allowed {
  28     my ( $self, $c, $class, $action ) = @_;
  29
  30     # skip internal links
  31     if (
  32         $action
  33         && (   $action =~ m/\/?(?:_[A-Z]+|auto|begin|end)$/o
  34             || $action =~ m/(?:->process$|^default$)/o )
  35       )
  36     {
  37         return 1;
  38     }
  39
  40     if ( my $check = $self->{ rules }->{ $action } ) {
  41         my $ret = $check->( $c );
  42
  43         return $ret;
  44     }
  45
  46     if ( my $check = $self->{ rules }->{ '*' } ) {
  47         return $check->( $c );
  48     }
  49
  50     return 0;
  51 }
  52
  53 =head1 AUTHOR
  54
  55 vti
  56
  57 =head1 COPYRIGHT
  58
  59 This program is free software, you can redistribute it and/or modify it under
  60 the same terms as Perl itself.
  61
  62 =cut
  63
  64 1;