--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Web/Application/CustomResourceContract.pm	Sat Sep 29 02:34:47 2012 +0400
@@ -0,0 +1,76 @@
+package IMPL::Web::Application::CustomResourceContract;
+use strict;
+
+use IMPL::lang qw(:constants);
+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 ($resource->can($methodName)) {
+                    return $resource->$methodName($action);
+                } else {
+                    die NotAllowedException->new(allow => join(',', _GetAllowedHttpMethods($resource)));
+                }
+                 
+            }
+        );
+    }
+}
+
+sub _HttpOptionsBinding {
+    my ($resource) = @_;
+    
+    my @allow = _GetAllowedHttpMethods;
+    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