diff Lib/IMPL/Web/Application/RestBaseResource.pm @ 200:a9dbe534d236

sync
author sergey
date Tue, 24 Apr 2012 02:34:49 +0400
parents
children 0c018a247c8a
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Web/Application/RestBaseResource.pm	Tue Apr 24 02:34:49 2012 +0400
@@ -0,0 +1,138 @@
+package IMPL::Web::Application::RestBaseResource;
+use strict;
+
+use IMPL::lang qw(:declare :constants);
+use IMPL::declare {
+	require => {
+		Exception => 'IMPL::Exception',
+		ArgumentException => '-IMPL::InvalidArgumentException',
+		NotImplException => '-IMPL::NotImplementedException',
+		ForbiddenException => 'IMPL::Web::ForbiddenException',
+		TTransform => '-IMPL::Transform',
+        TResolve => '-IMPL::Config::Resolve'
+	},
+    base => {
+        'IMPL::Object' => undef,
+        'IMPL::Object::Autofill' => '@_'
+    }
+};
+
+
+BEGIN {
+    public property id => PROP_GET | PROP_OWNERSET;
+    public property parent => PROP_GET | PROP_OWNERSET;
+    public property contract => PROP_GET | PROP_OWNERSET;
+}
+
+sub target {
+	shift;
+}
+
+sub CTOR {
+    my ($this) = @_;
+    
+    die ArgumentException->new("id","Identifier is required for non-root resources") if $this->id and not length $this->id;
+    die ArgumentException->new("A contract is required") unless $this->contract;
+}
+
+sub GetHttpImpl {
+    my($this,$method) = @_;
+    
+    my %map = (
+        GET => 'GetImpl',
+        PUT => 'PutImpl',
+        POST => 'PostImpl',
+        DELETE => 'DeleteImpl'
+    );
+    
+    return $map{$method};
+}
+
+sub InvokeHttpMethod {
+    my ($this,$method,$childId,$action) = @_;
+    
+    my $impl = $this->GetHttpImpl($method) || 'HttpFallbackImpl';
+    
+    return $this->$impl($childId,$action);
+}
+
+sub GetImpl {
+	die NotImplException->new();
+}
+
+sub PutImpl {
+    die NotImplException->new();
+}
+
+sub PostImpl {
+    die NotImplException->new();
+}
+
+sub DeleteImpl {
+    die NotImplException->new();
+}
+
+sub HttpFallbackImpl {
+    die ForbiddenException->new();
+}
+
+sub InvokeMember {
+    my ($this,$method,$action) = @_;
+    
+    die ArgumentException->new("method","No method information provided") unless $method;
+    
+    #normalize method info
+    if (not ref $method) {
+        $method = {
+            method => $method
+        };
+    }
+    
+    if (ref $method eq 'HASH') {
+        my $member = $method->{method} or die InvalidOpException->new("A member name isn't specified");
+        my @args;
+    
+        if (my $params = $method->{parameters}) {
+            if (ref $params eq 'HASH') {
+                @args = map {
+                    $_,
+                    $this->MakeParameter($params->{$_},$action)
+                } keys %$params;                
+            } elsif (ref $params eq 'ARRAY') {
+                @args = map $this->MakeParameter($_,$action), @$params;
+            } else {
+                @args = ($this->MakeParameter($params,$action)); 
+            }
+        }
+        return $this->target->$member(@args);
+    } elsif (ref $method eq TResolve) {
+        return $method->Invoke($this->target);
+    } elsif (ref $method eq 'CODE') {
+        return $method->($this->target,$action);
+    } else {
+        die InvalidOpException->new("Unsupported type of the method information", ref $method);
+    }
+}
+
+sub MakeParameter {
+    my ($this,$param,$action) = @_;
+    
+    if ($param) {
+        if (is $param, TTransform ) {
+            return $param->Transform($this,$action->query);
+        } elsif ($param and not ref $param) {
+            my %std = (
+                id => $this->id,
+                action => $action,
+                query => $action->query
+            );
+            
+            return $std{$param} || $action->query->param($param);
+        }
+    } else {
+        return undef;
+    }
+}
+
+
+1; 
\ No newline at end of file