Mercurial > pub > Impl

annotate Lib/IMPL/Web/Application/RestBaseResource.pm @ 201:0c018a247c8a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Reworked REST resource classes to be more transparent and intuitive
author sergey
date Tue, 24 Apr 2012 19:52:07 +0400
parents a9dbe534d236
children 5146e17a7b76
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
200
sergey
parents:
diff changeset
1 package IMPL::Web::Application::RestBaseResource;
sergey
parents:
diff changeset
2 use strict;
sergey
parents:
diff changeset
3
sergey
parents:
diff changeset
4 use IMPL::lang qw(:declare :constants);
sergey
parents:
diff changeset
5 use IMPL::declare {
sergey
parents:
diff changeset
6 require => {
sergey
parents:
diff changeset
7 Exception => 'IMPL::Exception',
sergey
parents:
diff changeset
8 ArgumentException => '-IMPL::InvalidArgumentException',
sergey
parents:
diff changeset
9 NotImplException => '-IMPL::NotImplementedException',
sergey
parents:
diff changeset
10 ForbiddenException => 'IMPL::Web::ForbiddenException',
sergey
parents:
diff changeset
11 TTransform => '-IMPL::Transform',
sergey
parents:
diff changeset
12 TResolve => '-IMPL::Config::Resolve'
sergey
parents:
diff changeset
13 },
sergey
parents:
diff changeset
14 base => {
sergey
parents:
diff changeset
15 'IMPL::Object' => undef,
sergey
parents:
diff changeset
16 'IMPL::Object::Autofill' => '@_'
sergey
parents:
diff changeset
17 }
sergey
parents:
diff changeset
18 };
sergey
parents:
diff changeset
19
sergey
parents:
diff changeset
20
sergey
parents:
diff changeset
21 BEGIN {
sergey
parents:
diff changeset
22 public property id => PROP_GET | PROP_OWNERSET;
sergey
parents:
diff changeset
23 public property parent => PROP_GET | PROP_OWNERSET;
sergey
parents:
diff changeset
24 public property contract => PROP_GET | PROP_OWNERSET;
201
0c018a247c8a Reworked REST resource classes to be more transparent and intuitive
sergey
parents: 200
diff changeset
25 protected property final => PROP_ALL;
200
sergey
parents:
diff changeset
26 }
sergey
parents:
diff changeset
27
sergey
parents:
diff changeset
28 sub target {
sergey
parents:
diff changeset
29 shift;
sergey
parents:
diff changeset
30 }
sergey
parents:
diff changeset
31
sergey
parents:
diff changeset
32 sub CTOR {
sergey
parents:
diff changeset
33 my ($this) = @_;
sergey
parents:
diff changeset
34
sergey
parents:
diff changeset
35 die ArgumentException->new("id","Identifier is required for non-root resources") if $this->id and not length $this->id;
sergey
parents:
diff changeset
36 die ArgumentException->new("A contract is required") unless $this->contract;
sergey
parents:
diff changeset
37 }
sergey
parents:
diff changeset
38
sergey
parents:
diff changeset
39 sub GetHttpImpl {
sergey
parents:
diff changeset
40 my($this,$method) = @_;
sergey
parents:
diff changeset
41
sergey
parents:
diff changeset
42 my %map = (
sergey
parents:
diff changeset
43 GET => 'GetImpl',
sergey
parents:
diff changeset
44 PUT => 'PutImpl',
sergey
parents:
diff changeset
45 POST => 'PostImpl',
sergey
parents:
diff changeset
46 DELETE => 'DeleteImpl'
sergey
parents:
diff changeset
47 );
sergey
parents:
diff changeset
48
sergey
parents:
diff changeset
49 return $map{$method};
sergey
parents:
diff changeset
50 }
sergey
parents:
diff changeset
51
sergey
parents:
diff changeset
52 sub InvokeHttpMethod {
201
0c018a247c8a Reworked REST resource classes to be more transparent and intuitive
sergey
parents: 200
diff changeset
53 my ($this,$method,$action) = @_;
200
sergey
parents:
diff changeset
54
sergey
parents:
diff changeset
55 my $impl = $this->GetHttpImpl($method) || 'HttpFallbackImpl';
sergey
parents:
diff changeset
56
201
0c018a247c8a Reworked REST resource classes to be more transparent and intuitive
sergey
parents: 200
diff changeset
57 return $this->$impl($action);
200
sergey
parents:
diff changeset
58 }
sergey
parents:
diff changeset
59
sergey
parents:
diff changeset
60 sub GetImpl {
sergey
parents:
diff changeset
61 die NotImplException->new();
sergey
parents:
diff changeset
62 }
sergey
parents:
diff changeset
63
sergey
parents:
diff changeset
64 sub PutImpl {
sergey
parents:
diff changeset
65 die NotImplException->new();
sergey
parents:
diff changeset
66 }
sergey
parents:
diff changeset
67
sergey
parents:
diff changeset
68 sub PostImpl {
sergey
parents:
diff changeset
69 die NotImplException->new();
sergey
parents:
diff changeset
70 }
sergey
parents:
diff changeset
71
sergey
parents:
diff changeset
72 sub DeleteImpl {
sergey
parents:
diff changeset
73 die NotImplException->new();
sergey
parents:
diff changeset
74 }
sergey
parents:
diff changeset
75
sergey
parents:
diff changeset
76 sub HttpFallbackImpl {
sergey
parents:
diff changeset
77 die ForbiddenException->new();
sergey
parents:
diff changeset
78 }
sergey
parents:
diff changeset
79
201
0c018a247c8a Reworked REST resource classes to be more transparent and intuitive
sergey
parents: 200
diff changeset
80 sub FetchChildResource {
0c018a247c8a Reworked REST resource classes to be more transparent and intuitive
sergey
parents: 200
diff changeset
81 return undef;
0c018a247c8a Reworked REST resource classes to be more transparent and intuitive
sergey
parents: 200
diff changeset
82 }
0c018a247c8a Reworked REST resource classes to be more transparent and intuitive
sergey
parents: 200
diff changeset
83
200
sergey
parents:
diff changeset
84 sub InvokeMember {
sergey
parents:
diff changeset
85 my ($this,$method,$action) = @_;
sergey
parents:
diff changeset
86
sergey
parents:
diff changeset
87 die ArgumentException->new("method","No method information provided") unless $method;
sergey
parents:
diff changeset
88
sergey
parents:
diff changeset
89 #normalize method info
sergey
parents:
diff changeset
90 if (not ref $method) {
sergey
parents:
diff changeset
91 $method = {
sergey
parents:
diff changeset
92 method => $method
sergey
parents:
diff changeset
93 };
sergey
parents:
diff changeset
94 }
sergey
parents:
diff changeset
95
sergey
parents:
diff changeset
96 if (ref $method eq 'HASH') {
sergey
parents:
diff changeset
97 my $member = $method->{method} or die InvalidOpException->new("A member name isn't specified");
201
0c018a247c8a Reworked REST resource classes to be more transparent and intuitive
sergey
parents: 200
diff changeset
98
200
sergey
parents:
diff changeset
99 my @args;
sergey
parents:
diff changeset
100
sergey
parents:
diff changeset
101 if (my $params = $method->{parameters}) {
sergey
parents:
diff changeset
102 if (ref $params eq 'HASH') {
sergey
parents:
diff changeset
103 @args = map {
sergey
parents:
diff changeset
104 $_,
sergey
parents:
diff changeset
105 $this->MakeParameter($params->{$_},$action)
sergey
parents:
diff changeset
106 } keys %$params;
sergey
parents:
diff changeset
107 } elsif (ref $params eq 'ARRAY') {
sergey
parents:
diff changeset
108 @args = map $this->MakeParameter($_,$action), @$params;
sergey
parents:
diff changeset
109 } else {
sergey
parents:
diff changeset
110 @args = ($this->MakeParameter($params,$action));
sergey
parents:
diff changeset
111 }
sergey
parents:
diff changeset
112 }
sergey
parents:
diff changeset
113 return $this->target->$member(@args);
sergey
parents:
diff changeset
114 } elsif (ref $method eq TResolve) {
sergey
parents:
diff changeset
115 return $method->Invoke($this->target);
sergey
parents:
diff changeset
116 } elsif (ref $method eq 'CODE') {
201
0c018a247c8a Reworked REST resource classes to be more transparent and intuitive
sergey
parents: 200
diff changeset
117 return $method->($this,$action);
200
sergey
parents:
diff changeset
118 } else {
sergey
parents:
diff changeset
119 die InvalidOpException->new("Unsupported type of the method information", ref $method);
sergey
parents:
diff changeset
120 }
sergey
parents:
diff changeset
121 }
sergey
parents:
diff changeset
122
sergey
parents:
diff changeset
123 sub MakeParameter {
sergey
parents:
diff changeset
124 my ($this,$param,$action) = @_;
sergey
parents:
diff changeset
125
sergey
parents:
diff changeset
126 if ($param) {
sergey
parents:
diff changeset
127 if (is $param, TTransform ) {
sergey
parents:
diff changeset
128 return $param->Transform($this,$action->query);
sergey
parents:
diff changeset
129 } elsif ($param and not ref $param) {
201
0c018a247c8a Reworked REST resource classes to be more transparent and intuitive
sergey
parents: 200
diff changeset
130 return $action->query->param($param);
0c018a247c8a Reworked REST resource classes to be more transparent and intuitive
sergey
parents: 200
diff changeset
131 } else {
0c018a247c8a Reworked REST resource classes to be more transparent and intuitive
sergey
parents: 200
diff changeset
132 die new InvalidOpException->new("Unsupported parameter mapping", $param);
200
sergey
parents:
diff changeset
133 }
sergey
parents:
diff changeset
134 } else {
sergey
parents:
diff changeset
135 return undef;
sergey
parents:
diff changeset
136 }
sergey
parents:
diff changeset
137 }
sergey
parents:
diff changeset
138
sergey
parents:
diff changeset
139
201
0c018a247c8a Reworked REST resource classes to be more transparent and intuitive
sergey
parents: 200
diff changeset
140 1;
0c018a247c8a Reworked REST resource classes to be more transparent and intuitive
sergey
parents: 200
diff changeset
141
0c018a247c8a Reworked REST resource classes to be more transparent and intuitive
sergey
parents: 200
diff changeset
142 __END__
0c018a247c8a Reworked REST resource classes to be more transparent and intuitive
sergey
parents: 200
diff changeset
143
0c018a247c8a Reworked REST resource classes to be more transparent and intuitive
sergey
parents: 200
diff changeset
144 =pod
0c018a247c8a Reworked REST resource classes to be more transparent and intuitive
sergey
parents: 200
diff changeset
145
0c018a247c8a Reworked REST resource classes to be more transparent and intuitive
sergey
parents: 200
diff changeset
146
0c018a247c8a Reworked REST resource classes to be more transparent and intuitive
sergey
parents: 200
diff changeset
147
0c018a247c8a Reworked REST resource classes to be more transparent and intuitive
sergey
parents: 200
diff changeset
148 =cut