view release on metacpan or  search on metacpan

lib/CGI/Application/Plugin/Authorization.pm  view on Meta::CPAN

      push( @{$config->{AUTHZ_RUNMODES}}, [$rm, $group] );
    }

    return @{$config->{AUTHZ_RUNMODES}};
}

=head2 is_authz_runmode

This method accepts the name of a runmode, and if that runmode requires
authorization (ie the user needs to be a member of a particular group
or has to satisfy some other authorization rule) then this method
returns the corresponding authorization rule which must be satisfied
(which could be either a scalar, a list-ref, or a code-ref, depending
on how the rules were defined).

=cut

sub is_authz_runmode {
    my $self = shift;
    my $runmode = shift;

    foreach my $runmode_info ($self->authz_runmodes) {
      my ($runmode_test, $rule) = @$runmode_info;
      if (overload::StrVal($runmode_test) =~ /^Regexp=/) {
	# We were passed a regular expression
	return $rule if $runmode =~ $runmode_test;
      } elsif (ref $runmode_test && ref $runmode_test eq 'CODE') {
	# We were passed a code reference
	return $rule if $runmode_test->($runmode);
      } elsif ($runmode_test eq ':all') {
	# all runmodes are protected
	return $rule;
      } else {
	# assume we were passed a string
	return $rule if $runmode eq $runmode_test;
      }
    }

    return undef;
}

=head2 new

This method creates a new L<CGI::Application::Plugin::Authorization> object.
It requires as it's only parameter a L<CGI::Application> object.  This method
should never be called directly, since the C<authz> method that is imported
into the L<CGI::Application> module will take care of creating the
L<CGI::Application::Plugin::Authorization> object when it is required.

=cut

sub new {
    my $class  = shift;
    my $name   = shift;
    my $cgiapp = shift;
    my $self   = {};

    bless $self, $class;
    $self->{name}   = $name;
    $self->{cgiapp} = $cgiapp;
    Scalar::Util::weaken( $self->{cgiapp} )
        if ref $self->{cgiapp};    # weaken circular reference

    return $self;
}

=head2 instance

This method works the same way as C<new>, except that it returns the same
Authorization object for the duration of the request.  This method should never
be called directly, since the C<authz> method that is imported into the
L<CGI::Application> module will take care of creating the
L<CGI::Application::Plugin::Authorization> object when it is required.

=cut

sub instance {
    my $class  = shift;
    my $name   = shift ||'';
    my $cgiapp = shift;
    die
        "CGI::Application::Plugin::Authorization->instance must be called with a CGI::Application object or class name"
        unless defined $cgiapp
        && UNIVERSAL::isa( $cgiapp, 'CGI::Application' );

    if ( ref $cgiapp ) {
        # being called from a CGI::Application object
        $cgiapp->{__CAP_AUTHORIZATION_INSTANCE}->{$name}
            = $class->new( $name, $cgiapp )
            unless defined $cgiapp->{__CAP_AUTHORIZATION_INSTANCE}->{$name};
        return $cgiapp->{__CAP_AUTHORIZATION_INSTANCE}->{$name};
    }
    else {
        # being called from a CGI::Application class
        return $class->new( $name, $cgiapp );
    }
}

=head2 authorize

This method will test to see if the current user has access to the given
resource.  It will take the given parameters and test them against the DRIVER
classes that have been configured.  A true return value means the user should
have access to the given resource.

 # is the current user in the admin group
 if ($self->authz->authorize('admingroup')) {
    # perform an admin action
 }

=cut

sub authorize {
    my $self   = shift;
    my @params = @_;

    foreach my $driver ( $self->drivers ) {
        return 1 if $driver->authorize(@params);
    }
    return 0;
}