Mercurial > pub > Impl

comparison Lib/IMPL/Web/Application/Resource.pm @ 373:3ca44e23fd1f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
implemented new web resource
author cin
date Wed, 25 Dec 2013 17:29:38 +0400
parents
children 6608db5dcb81
comparison
equal deleted inserted replaced
372:e12c14177848 373:3ca44e23fd1f
1 package IMPL::Web::Application::Resource;
2 use strict;
3
4 use constant {
5 ResourceClass => __PACKAGE__
6 };
7 use Scalar::Util qw(blessed);
8
9 use IMPL::lang qw(:hash :base);
10 use IMPL::Const qw(:prop);
11 use IMPL::declare {
12 require => {
13 Exception => 'IMPL::Exception',
14 OpException => '-IMPL::InvalidOperationException',
15 NotFoundException => 'IMPL::Web::NotFoundException',
16 ResourceInterface => '-IMPL::Web::Application',
17 Loader => 'IMPL::Code::Loader'
18 },
19 base => [
20 'IMPL::Object' => undef,
21 'IMPL::Web::Application::ResourceBase' => '@_'
22 ],
23 props => [
24 access => PROP_RW,
25 verbs => PROP_RW,
26 children => PROP_RW
27 ]
28 };
29
30 __PACKAGE__->static_accessor(verbNames => [qw(get post put delete options head)]);
31 __PACKAGE__->static_accessor(httpMethodPrefix => 'Http');
32
33 sub CTOR {
34 my ($this, %args) = @_;
35
36 my %verbs;
37 my $httpPrefix = $this->httpMethodPrefix;
38
39 foreach my $verb (@{$this->verbNames}) {
40 my $method = exists $args{$verb} ? $args{$verb} : $this->can($httpPrefix . ucfirst($verb));
41 $verbs{$verb} = $method
42 if $method;
43 }
44
45 hashApply(\%verbs,$args{verbs})
46 if ref($args{verbs}) eq 'HASH' ;
47
48 $this->children($args{children} || $this->GetChildResources());
49
50 $this->access($args{access})
51 if $args{access};
52
53 $this->verbs(\%verbs);
54 }
55
56 sub _isInvokable {
57 my ($this,$method) = @_;
58
59 return
60 (blessed($method) and $method->can('Invoke')) ||
61 ref($method) eq 'CODE'
62 }
63
64 sub _invoke {
65 my ($this,$method,@args) = @_;
66
67 if(blessed($method) and $method->can('Invoke')) {
68 return $method->Invoke($this,@args);
69 } elsif(ref($method) eq 'CODE' || (not(ref($method)) and $this->can($method))) {
70 return $this->$method(@args);
71 } else {
72 die OpException->new("Can't invoke the specified method: $method");
73 }
74 }
75
76 sub HttpGet {
77 shift->model;
78 }
79
80 sub Fetch {
81 my ($this,$childId) = @_;
82
83 my $children = $this->children
84 or die NotFoundException->new( $this->location->url, $childId );
85
86 if (ref($children) eq 'HASH') {
87 return $children->{$childId};
88 } else {
89 return $this->_invoke($children,$childId);
90 }
91 }
92
93 sub FetchChildResource {
94 my ($this,$childId) = @_;
95
96 my $info = $this->Fetch($childId);
97
98 return $info
99 if (is($info,ResourceInterface));
100
101 return $this->CreateChildResource($info, $childId)
102 if ref($info) eq 'HASH';
103
104 die OpException->new("Invalid resource description", $childId, $info);
105 }
106
107 sub CreateChildResource {
108 my ($this,$info, $childId) = @_;
109
110 my $params = hashApply(
111 {
112 parent => $this,
113 id => $childId,
114 request => $this->request,
115 class => ResourceClass
116 },
117 $info
118 );
119
120 $params->{model} = $this->_invoke($params->{model})
121 if $this->_isInvokable($params->{model});
122
123 my $factory = Loader->default->Require($params->{class});
124
125 return $factory->new(%$params);
126 }
127
128 sub GetChildResources {
129 return {};
130 }
131
132 1;
133
134 __END__
135
136 =pod
137
138 =head1 NAME
139
140 C<IMPL::Web::Application::Resource> - Ресурс C<REST> веб приложения
141
142 =head1 SYNOPSIS
143
144 =begin code
145
146 use IMPL::require {
147 Resource => 'IMPL::Web::Application::Resource',
148 Security => 'IMPL::Security',
149 NotFoundException => 'IMPL::Web::NotFoundException',
150 ForbiddenException => 'IMPL::Web::ForbiddenException'
151 };
152
153 my $model = Resource->new(
154 get => sub { },
155 verbs => {
156 # non-standart verbs placed here
157 myverb => sub { }
158 },
159 #child resources can be a hash
160 chidren => {
161 user => {
162 # a resource class may be specified optionally
163 # class => Resource,
164 model => sub {
165 return Security->principal
166 },
167 # the default get implementation is implied
168 # get => sub { shift->model },
169 access => sub {
170 my ($this,$verb) = @_;
171 die ForbiddenException->new()
172 if Security->principal->isNobody
173 }
174 },
175 catalog => {
176 get => sub {
177 my $ctx = shift->application->ConnectDb()->AutoPtr();
178
179 return $ctx->products->find_rs({ in_stock => 1 });
180 },
181 # chid resource may be created dynamically
182 children => sub {
183 # binds model against the parent reource and id
184 my ($this,$id) = @_;
185
186 ($id) = ($id =~ /^(\w+)$/)
187 or die NotFoundException->new($id);
188
189 my $ctx = shift->application->ConnectDb()->AutoPtr();
190
191 my $item = $ctx->products->fetch($id);
192
193 die NotFoundException->new()
194 unless $item;
195
196 # return parameters for the new resource
197 return {
198 model => $item,
199 get => sub { shift->model }
200 };
201 }
202 },
203 # dynamically binds whole child resource. The result of binding is
204 # the new resource or a hash with arguments to create one
205 posts => sub {
206 my ($this,$id) = @_;
207
208 # this approach can be used to create a dynamic resource relaying
209 # on the type of the model
210
211 return Resource->new(
212 id => $id,
213 parent => $this,
214 get => sub { shift->model }
215 );
216
217 # ditto
218 # parent and id will be mixed in automagically
219 # return { get => sub { shift->model} }
220 },
221 post_only => {
222 get => undef, # remove GET verb implicitly
223 post => sub {
224 my ($this) = @_;
225 }
226 }
227 }
228 );
229
230 =end code
231
232 Альтернативный вариант для создания класса ресурса.
233
234 =begin code
235
236 package MyResource;
237
238 use IMPL::declare {
239 require => {
240 ForbiddenException => 'IMPL::Web::ForbiddenException'
241 },
242 base => [
243 'IMPL::Web::Application::Resource' => '@_'
244 ]
245 };
246
247 sub ds {
248 my ($this) = @_;
249
250 $this->context->{ds} ||= $this->application->ConnectDb();
251 }
252
253 sub InvokeHttpVerb {
254 my $this = shift;
255
256 $this->ds->Begin();
257
258 my $result = $this->next::method(@_);
259
260 # in case of error the data context will be disposed and the transaction
261 # will be reverted
262 $this->ds->Commit();
263
264 return $result;
265 }
266
267 # this method is inherited by default
268 # sub HttpGet {
269 # shift->model
270 #
271 # }
272
273 sub HttpPost {
274 my ($this) = @_;
275
276 my %data = map {
277 $_,
278 $this->request->param($_)
279 } qw(name description value);
280
281 die ForbiddenException->new("The item with the scpecified name can't be created'")
282 if(not $data{name} or $this->ds->items->find({ name => $data{name}))
283
284 $this->ds->items->insert(\%data);
285
286 return $this->NoContent();
287 }
288
289 sub Fetch {
290 my ($this,$childId) = @_;
291
292 my $item = $this->ds->items->find({name => $childId})
293 or die NotFoundException->new();
294
295 # return parameters for the child resource
296 return { model => $item, role => "item food" };
297 }
298
299 =end code
300
301 =cut
302