# HG changeset patch
# User cin
# Date 1371140004 -14400
# Node ID e8be9062ecf2e76f0bd773c9f82cd899b93ad8de
# Parent  71221d79e6b4db89f418b665f75c6fb8c90d0262
improved resource classes, contracts are deprecated

diff -r 71221d79e6b4 -r e8be9062ecf2 Lib/IMPL/Web/Application/CustomResource.pm
--- a/Lib/IMPL/Web/Application/CustomResource.pm	Thu Jun 13 02:24:57 2013 +0400
+++ b/Lib/IMPL/Web/Application/CustomResource.pm	Thu Jun 13 20:13:24 2013 +0400
@@ -12,7 +12,11 @@
         'IMPL::Web::Application::Resource' => '@_'
     ],
     props => [
-        accessCheck => PROP_RW
+        accessCheck => PROP_RW,
+        resources   => PROP_RO,
+        verbs       => PROP_RO,
+        namedResources => PROP_RO,
+        regexResources => PROP_RO
     ]
 };
 
@@ -21,61 +25,61 @@
     POST => 'HttpPost',
     PUT => 'HttpPut',
     DELETE => 'HttpDelete',
-    HEAD => 'HttpHead'
+    HEAD => 'HttpHead',
+    OPTIONS => 'HttpOptions',
+    TRACE => 'HttpTrace'
 );
 
-__PACKAGE__->static_accessor(_rxResourcesMap => undef, 'own');
-__PACKAGE__->static_accessor(_nameResourcesMap => undef, 'own');
-
-sub namedResources {
-    shift->_nameResourcesMap;
-}
-
-sub regexResources {
-    shift->_rxResourcesMap;
-}
-
 sub CTOR {
 	my ($this,%args) = @_;
 	
+	$this->verbs($args{verbs} || {});
+	$this->resources($args{resources} || []);
+	
 	$this->accessCheck($args{accessCheck})
 	   if $args{accessCheck};
 	   
-	$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)));
-            }
-        }
+    	if(my $method = $this->can($methodName)) {
+    		$this->verbs->{lc($verb)} ||= $method;
+    	}
     }
 }
 
 sub FindChildResourceInfo {
     my ( $this, $name ) = @_;
     
-    $this->_PrepareResourcesCache()
-        unless($this->_nameResourcesMap);
-        
-    return $this->next::method($name);
+    $this->PrepareResourcesCache()
+        unless $this->namedResources;
+    
+    if ( my $info = $this->namedResources->{$name} ) {
+        return $info, [$name];
+    }
+    else {
+        foreach my $info ( @{$this->regexResources} ) {
+            my $rx = $info->{match};
+            if(my @childId = $name =~ m/$rx/) {
+                return $info, \@childId; 
+            }
+        }
+    }
+
+    return;
+}
+
+sub GetAllowedMethods {
+    map( uc, keys %{ shift->verbs } );
 }
 
 sub PrepareResourcesCache {
-    # suppress default caching mechanisn
-}
-
-sub _PrepareResourcesCache {
-    # a little bit wired
-    my ($self) = @_;
+    my ($this) = @_;
+    
+    my @resources = ($this->GetChildResources(), @{$this->resources});
+    
     my %nameMap;
     my @rxMap;
 
-    foreach my $res ($self->GetChildResources()) {
+    foreach my $res (@resources) {
         #skip resources without contract
         next unless $res->{contract};
         
@@ -87,8 +91,8 @@
         }
     }
 
-    $self->_rxResourcesMap(\@rxMap);
-    $self->_nameResourcesMap(\%nameMap);
+    $this->regexResources(\@rxMap);
+    $this->namedResources(\%nameMap);
 }
 
 sub AccessCheck {
@@ -105,10 +109,10 @@
     
 }
 
-sub _HttpOptionsBinding {
+sub HttpOptions {
     my ($this) = @_;
     
-    my @allow = $this->_GetAllowedHttpMethods();
+    my @allow = $this->GetAllowedMethods();
     return HttpResponse->new(
         status => '200 OK',
         headers => {
@@ -117,12 +121,6 @@
     );
 }
 
-sub _GetAllowedHttpMethods {
-    my ($this) = @_;
-    return grep $this->can($RESOURCE_BINDINGS{$_}), keys %RESOURCE_BINDINGS;
-}
-
-
 1;
 
 __END__
diff -r 71221d79e6b4 -r e8be9062ecf2 Lib/IMPL/Web/Application/Resource.pm
--- a/Lib/IMPL/Web/Application/Resource.pm	Thu Jun 13 02:24:57 2013 +0400
+++ b/Lib/IMPL/Web/Application/Resource.pm	Thu Jun 13 20:13:24 2013 +0400
@@ -13,7 +13,8 @@
 		OperationException  => '-IMPL::InvalidOperationException',
 		NotAllowedException => 'IMPL::Web::NotAllowedException',
 		NotFoundException   => 'IMPL::Web::NotFoundException',
-		Loader              => 'IMPL::Code::Loader' 
+		Loader              => 'IMPL::Code::Loader',
+		CustomResource      => '-IMPL::Web::Application::CustomResource' 
 	  },
 	  base => [
 		'IMPL::Object'                              => undef,
@@ -26,10 +27,6 @@
 		model       => PROP_RO,
 		id          => PROP_RO,
 		location    => PROP_RO,
-		resources   => PROP_RO,
-		verbs       => PROP_RO,
-		namedResources => PROP_RO,
-		regexResources => PROP_RO
 	  ]
 };
 
@@ -48,45 +45,20 @@
 	$this->model( $args{model} );
 	$this->id( $args{id} );
 	$this->application( $args{request}->application );
-	$this->verbs( $args{verbs} || {} );
-	$this->resources($args{resources} || []);
 	
-	$this->PrepareResourcesCache();
-
 # если расположение явно не указано, то оно вычисляется автоматически,
 # либо остается не заданным
 	$this->location( $args{location}
 		  || eval { $this->parent->location->Child( $this->id ) } );
 }
 
-sub PrepareResourcesCache {
-    my ($this,$resources) = @_;
-    my %nameMap;
-    my @rxMap;
-
-    foreach my $res (@{$this->resources}) {
-        #skip resources without contract
-        next unless $res->{contract};
-        
-        if ( my $name = $res->{name} ) {
-            $nameMap{$name} = $res;
-        }
-        if ( $res->{match} ) {
-            push @rxMap,$res;
-        }
-    }
-
-    $this->regexResources(\@rxMap);
-    $this->namedResources(\%nameMap);
-}
-
 sub InvokeHttpVerb {
 	my ( $this, $verb ) = @_;
 
 	my $operation = $this->verbs->{ lc($verb) };
 
 	die NotAllowedException->new(
-		allow => join( ',', map( uc, keys %{ $this->verbs } ) ) )
+		allow => join( ',', $this->GetAllowedMethods ) )
 	  unless $operation;
 
 	$this->AccessCheck($verb);
@@ -110,6 +82,14 @@
 	return _InvokeDelegate( $operation, $this, $request );
 }
 
+sub GetAllowedMethods {
+	
+}
+
+sub FindChildResourceInfo {
+	
+}
+
 sub AccessCheck {
 
 }
@@ -129,24 +109,6 @@
 	return $env;
 }
 
-sub FindChildResourceInfo {
-    my ( $this, $name ) = @_;
-    
-    if ( my $info = $this->namedResources->{$name} ) {
-        return $info, [$name];
-    }
-    else {
-        foreach my $info ( @{$this->regexResources} ) {
-            my $rx = $info->{match};
-            if(my @childId = $name =~ m/$rx/) {
-                return $info, \@childId; 
-            }
-        }
-    }
-
-    return;
-}
-
 # это реализация по умолчанию, базируется информации о ресурсах, содержащийся
 # в контракте.
 sub FetchChildResource {
@@ -186,7 +148,7 @@
 	my $factory;
 	
 	if (ref($contract) eq 'HASH') {
-	    $factory = delete $contract->{class} || __PACKAGE__;
+	    $factory = delete $contract->{class} || CustomResource;
 	    hashApply(\%args,$contract);
 	    
 	    Loader->default->Require($factory)