Mercurial > pub > Impl
view Lib/IMPL/Web/Application/CustomResourceContract.pm @ 258:91bae9f41a9c
Added class for referencing paths in configuration files
author | sergey |
---|---|
date | Tue, 18 Dec 2012 19:18:31 +0400 |
parents | 6d8092d8ce1b |
children | 4abda21186cd |
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{$_}), values %RESOURCE_BINDINGS; } 1; __END__ =pod =head1 NAME C<IMPL::Web::Application::CustomResourceContract> - контракт для веб-ресурсов, реальзуемых в коде см. C<IMPL::Web::Application::CustomResource}>. =head1 DESCRIPTION Данный класс не используется напрямую. =cut