diff Lib/IMPL/Web/Application/CustomResource.pm @ 335:e8be9062ecf2

improved resource classes, contracts are deprecated
author cin
date Thu, 13 Jun 2013 20:13:24 +0400
parents 71221d79e6b4
children e12c14177848
line wrap: on
line diff
--- 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__