view Lib/IMPL/Web/Application/CustomResourceContract.pm @ 330:fe725fad2d90

Added access checking to web resources
author sergey
date Tue, 04 Jun 2013 19:25:54 +0400
parents 4abda21186cd
children 2ff1726c066c
line wrap: on
line source

package IMPL::Web::Application::CustomResourceContract;
use strict;

use IMPL::Const qw(:prop);
use IMPL::declare {
    require => {
        NotAllowedException => 'IMPL::Web::NotAllowedException',
        OperationContract => 'IMPL::Web::Application::OperationContract'
    },
    base => [
        'IMPL::Web::Application::ResourceContract' => '@_'
    ]
};

our %RESOURCE_BINDINGS = (
    GET => 'HttpGet',
    POST => 'HttpPost',
    PUT => 'HttpPut',
    DELETE => 'HttpDelete',
    HEAD => 'HttpHead'
);

sub CTOR {
    my ($this) = @_;
    
    $this->verbs->{options} ||= OperationContract->new( binding => \&_HttpOptionsBinding );
    
    while(my ($verb,$methodName) = each %RESOURCE_BINDINGS) {
        $this->verbs->{lc($verb)} ||= OperationContract->new (
            binding => sub {
                my ($resource,$action) = @_;
               
                if (eval { $resource->can($methodName) }) {
                    return $resource->$methodName($action);
                } else {
                    die NotAllowedException->new(allow => join(',', _GetAllowedHttpMethods($resource)));
                }
                 
            }
        );
    }
}

sub _HttpOptionsBinding {
    my ($resource) = @_;
    
    my @allow = _GetAllowedHttpMethods($resource);
    retrun HttpResponse->new(
        status => '200 OK',
        headers => {
            allow => join ( ',', @allow )
        }
    );
}

sub _GetAllowedHttpMethods {
    my ($resource) = @_;
    return grep $resource->can($RESOURCE_BINDINGS{$_}), keys %RESOURCE_BINDINGS;
}

1;

__END__

=pod

=head1 NAME

C<IMPL::Web::Application::CustomResourceContract> - контракт для веб-ресурсов,
реальзуемых в коде см. C<IMPL::Web::Application::CustomResource}>.

=head1 DESCRIPTION

Данный класс не используется напрямую.

=cut