|
200
|
1 package IMPL::Web::Application::RestBaseResource;
|
|
|
2 use strict;
|
|
|
3
|
|
|
4 use IMPL::lang qw(:declare :constants);
|
|
|
5 use IMPL::declare {
|
|
|
6 require => {
|
|
|
7 Exception => 'IMPL::Exception',
|
|
|
8 ArgumentException => '-IMPL::InvalidArgumentException',
|
|
|
9 NotImplException => '-IMPL::NotImplementedException',
|
|
|
10 ForbiddenException => 'IMPL::Web::ForbiddenException',
|
|
|
11 TTransform => '-IMPL::Transform',
|
|
|
12 TResolve => '-IMPL::Config::Resolve'
|
|
|
13 },
|
|
|
14 base => {
|
|
|
15 'IMPL::Object' => undef,
|
|
|
16 'IMPL::Object::Autofill' => '@_'
|
|
|
17 }
|
|
|
18 };
|
|
|
19
|
|
|
20
|
|
|
21 BEGIN {
|
|
|
22 public property id => PROP_GET | PROP_OWNERSET;
|
|
|
23 public property parent => PROP_GET | PROP_OWNERSET;
|
|
|
24 public property contract => PROP_GET | PROP_OWNERSET;
|
|
|
25 }
|
|
|
26
|
|
|
27 sub target {
|
|
|
28 shift;
|
|
|
29 }
|
|
|
30
|
|
|
31 sub CTOR {
|
|
|
32 my ($this) = @_;
|
|
|
33
|
|
|
34 die ArgumentException->new("id","Identifier is required for non-root resources") if $this->id and not length $this->id;
|
|
|
35 die ArgumentException->new("A contract is required") unless $this->contract;
|
|
|
36 }
|
|
|
37
|
|
|
38 sub GetHttpImpl {
|
|
|
39 my($this,$method) = @_;
|
|
|
40
|
|
|
41 my %map = (
|
|
|
42 GET => 'GetImpl',
|
|
|
43 PUT => 'PutImpl',
|
|
|
44 POST => 'PostImpl',
|
|
|
45 DELETE => 'DeleteImpl'
|
|
|
46 );
|
|
|
47
|
|
|
48 return $map{$method};
|
|
|
49 }
|
|
|
50
|
|
|
51 sub InvokeHttpMethod {
|
|
|
52 my ($this,$method,$childId,$action) = @_;
|
|
|
53
|
|
|
54 my $impl = $this->GetHttpImpl($method) || 'HttpFallbackImpl';
|
|
|
55
|
|
|
56 return $this->$impl($childId,$action);
|
|
|
57 }
|
|
|
58
|
|
|
59 sub GetImpl {
|
|
|
60 die NotImplException->new();
|
|
|
61 }
|
|
|
62
|
|
|
63 sub PutImpl {
|
|
|
64 die NotImplException->new();
|
|
|
65 }
|
|
|
66
|
|
|
67 sub PostImpl {
|
|
|
68 die NotImplException->new();
|
|
|
69 }
|
|
|
70
|
|
|
71 sub DeleteImpl {
|
|
|
72 die NotImplException->new();
|
|
|
73 }
|
|
|
74
|
|
|
75 sub HttpFallbackImpl {
|
|
|
76 die ForbiddenException->new();
|
|
|
77 }
|
|
|
78
|
|
|
79 sub InvokeMember {
|
|
|
80 my ($this,$method,$action) = @_;
|
|
|
81
|
|
|
82 die ArgumentException->new("method","No method information provided") unless $method;
|
|
|
83
|
|
|
84 #normalize method info
|
|
|
85 if (not ref $method) {
|
|
|
86 $method = {
|
|
|
87 method => $method
|
|
|
88 };
|
|
|
89 }
|
|
|
90
|
|
|
91 if (ref $method eq 'HASH') {
|
|
|
92 my $member = $method->{method} or die InvalidOpException->new("A member name isn't specified");
|
|
|
93 my @args;
|
|
|
94
|
|
|
95 if (my $params = $method->{parameters}) {
|
|
|
96 if (ref $params eq 'HASH') {
|
|
|
97 @args = map {
|
|
|
98 $_,
|
|
|
99 $this->MakeParameter($params->{$_},$action)
|
|
|
100 } keys %$params;
|
|
|
101 } elsif (ref $params eq 'ARRAY') {
|
|
|
102 @args = map $this->MakeParameter($_,$action), @$params;
|
|
|
103 } else {
|
|
|
104 @args = ($this->MakeParameter($params,$action));
|
|
|
105 }
|
|
|
106 }
|
|
|
107 return $this->target->$member(@args);
|
|
|
108 } elsif (ref $method eq TResolve) {
|
|
|
109 return $method->Invoke($this->target);
|
|
|
110 } elsif (ref $method eq 'CODE') {
|
|
|
111 return $method->($this->target,$action);
|
|
|
112 } else {
|
|
|
113 die InvalidOpException->new("Unsupported type of the method information", ref $method);
|
|
|
114 }
|
|
|
115 }
|
|
|
116
|
|
|
117 sub MakeParameter {
|
|
|
118 my ($this,$param,$action) = @_;
|
|
|
119
|
|
|
120 if ($param) {
|
|
|
121 if (is $param, TTransform ) {
|
|
|
122 return $param->Transform($this,$action->query);
|
|
|
123 } elsif ($param and not ref $param) {
|
|
|
124 my %std = (
|
|
|
125 id => $this->id,
|
|
|
126 action => $action,
|
|
|
127 query => $action->query
|
|
|
128 );
|
|
|
129
|
|
|
130 return $std{$param} || $action->query->param($param);
|
|
|
131 }
|
|
|
132 } else {
|
|
|
133 return undef;
|
|
|
134 }
|
|
|
135 }
|
|
|
136
|
|
|
137
|
|
|
138 1; |
