Mercurial > pub > Impl
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