Mercurial > pub > Impl
view Lib/IMPL/Web/Application/CustomResourceContract.pm @ 333:cd6409f66a5f
small fixes, request environment is deprecated
author | cin |
---|---|
date | Tue, 11 Jun 2013 20:22:52 +0400 |
parents | 2ff1726c066c |
children |
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' }, 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} ||= \&_HttpOptionsBinding; while(my ($verb,$methodName) = each %RESOURCE_BINDINGS) { $this->verbs->{lc($verb)} ||= 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