Mercurial > pub > Impl

comparison Lib/IMPL/Web/Application/CustomResourceContract.pm @ 230:6d8092d8ce1b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
*reworked IMPL::Security *reworked IMPL::Web::Security *refactoring
author sergey
date Mon, 08 Oct 2012 03:37:37 +0400
parents 47f77e6409f7
children 4abda21186cd
comparison
equal deleted inserted replaced
229:47f77e6409f7 230:6d8092d8ce1b
1 package IMPL::Web::Application::CustomResourceContract; 1 package IMPL::Web::Application::CustomResourceContract;
2 use strict; 2 use strict;
3 3
4 use IMPL::lang qw(:constants); 4 use IMPL::Const qw(:prop);
5 use IMPL::declare { 5 use IMPL::declare {
6 require => { 6 require => {
7 NotAllowedException => 'IMPL::Web::NotAllowedException', 7 NotAllowedException => 'IMPL::Web::NotAllowedException',
8 OperationContract => 'IMPL::Web::Application::OperationContract' 8 OperationContract => 'IMPL::Web::Application::OperationContract'
9 }, 9 },
13 }; 13 };
14 14
15 our %RESOURCE_BINDINGS = ( 15 our %RESOURCE_BINDINGS = (
16 GET => 'HttpGet', 16 GET => 'HttpGet',
17 POST => 'HttpPost', 17 POST => 'HttpPost',
18 PUT => 'HttpPut' 18 PUT => 'HttpPut',
19 DELETE => 'HttpDelete', 19 DELETE => 'HttpDelete',
20 HEAD => 'HttpHead' 20 HEAD => 'HttpHead'
21 ); 21 );
22 22
23 sub CTOR { 23 sub CTOR {
27 27
28 while(my ($verb,$methodName) = each %RESOURCE_BINDINGS) { 28 while(my ($verb,$methodName) = each %RESOURCE_BINDINGS) {
29 $this->verbs->{lc($verb)} = OperationContract->new ( 29 $this->verbs->{lc($verb)} = OperationContract->new (
30 binding => sub { 30 binding => sub {
31 my ($resource,$action) = @_; 31 my ($resource,$action) = @_;
32 32
33 if ($resource->can($methodName)) { 33 if (eval { $resource->can($methodName) }) {
34 return $resource->$methodName($action); 34 return $resource->$methodName($action);
35 } else { 35 } else {
36 die NotAllowedException->new(allow => join(',', _GetAllowedHttpMethods($resource))); 36 die NotAllowedException->new(allow => join(',', _GetAllowedHttpMethods($resource)));
37 } 37 }
38 38
42 } 42 }
43 43
44 sub _HttpOptionsBinding { 44 sub _HttpOptionsBinding {
45 my ($resource) = @_; 45 my ($resource) = @_;
46 46
47 my @allow = _GetAllowedHttpMethods; 47 my @allow = _GetAllowedHttpMethods($resource);
48 retrun HttpResponse->new( 48 retrun HttpResponse->new(
49 status => '200 OK', 49 status => '200 OK',
50 headers => { 50 headers => {
51 allow => join ( ',', @allow ) 51 allow => join ( ',', @allow )
52 } 52 }