|
407
|
1 package IMPL::Web::Application::ResourceBase;
|
|
|
2 use strict;
|
|
|
3
|
|
|
4 use URI;
|
|
|
5 use Carp qw(carp);
|
|
|
6 use IMPL::lang qw(:hash :base);
|
|
|
7 use IMPL::Const qw(:prop);
|
|
|
8 use IMPL::declare {
|
|
|
9 require => {
|
|
|
10
|
|
|
11 Exception => 'IMPL::Exception',
|
|
|
12 ArgumentException => '-IMPL::InvalidArgumentException',
|
|
|
13 OperationException => '-IMPL::InvalidOperationException',
|
|
|
14 NotAllowedException => 'IMPL::Web::NotAllowedException',
|
|
|
15
|
|
|
16 },
|
|
|
17 base => [
|
|
|
18 'IMPL::Object' => undef,
|
|
|
19 'IMPL::Web::Application::ResourceInterface' => undef
|
|
|
20 ],
|
|
|
21 props => [
|
|
|
22 request => PROP_RO,
|
|
|
23 application => PROP_RO,
|
|
|
24 parent => PROP_RO,
|
|
|
25 model => PROP_RO,
|
|
|
26 id => PROP_RO,
|
|
|
27 location => PROP_RO,
|
|
|
28 role => PROP_RO | PROP_LIST
|
|
|
29 ]
|
|
|
30 };
|
|
|
31
|
|
|
32 sub CTOR {
|
|
|
33 my ( $this, %args ) = @_;
|
|
|
34
|
|
|
35 die ArgumentException->new(request => 'A request object must be specified')
|
|
|
36 unless $args{request};
|
|
|
37
|
|
|
38 $this->request( $args{request} );
|
|
|
39 $this->parent( $args{parent} ) if $args{parent};
|
|
|
40 $this->model( $args{model} ) if $args{model};
|
|
|
41 $this->id( $args{id} ) if $args{id};
|
|
|
42 $this->application( $args{request}->application );
|
|
|
43
|
|
|
44 # если расположение явно не указано, то оно вычисляется автоматически,
|
|
|
45 # либо остается не заданным
|
|
|
46 $this->location( $args{location}
|
|
|
47 || eval { $this->parent->location->Child( $this->id ) } );
|
|
|
48
|
|
|
49 if (my $role = $args{role}) {
|
|
|
50 if (ref($role) eq 'ARRAY') {
|
|
|
51 $this->role($role);
|
|
|
52 } elsif (not ref($role)) {
|
|
|
53 $this->role(split(/\s+/, $role));
|
|
|
54 } else {
|
|
|
55 die ArgumentException->new( role => 'A invalid value is provided, expected ARRAY or SCALAR');
|
|
|
56 }
|
|
|
57 }
|
|
|
58 }
|
|
|
59
|
|
|
60 sub InvokeHttpVerb {
|
|
|
61 my ( $this, $verb ) = @_;
|
|
|
62
|
|
|
63 my $operation = $this->verbs->{ lc($verb) };
|
|
|
64
|
|
|
65 die NotAllowedException->new(
|
|
|
66 allow => join( ',', $this->GetAllowedMethods ) )
|
|
|
67 unless $operation;
|
|
|
68
|
|
|
69 $this->AccessCheck($verb);
|
|
|
70 my $request = $this->request;
|
|
|
71
|
|
|
72 # в случае, когда один ресурс вызывает HTTP метод другого ресурса, нужно
|
|
|
73 # сохранить оригинальный resourceLocation
|
|
|
74 $request->context->{resourceLocation} ||= $this->location;
|
|
|
75
|
|
|
76 # это свойство специфично только для REST приложений.
|
|
|
77 # сохранение текущего ресурса не повлечет за собой существенных расходов,
|
|
|
78 # т.к. они просто освободятся несколько позже.
|
|
|
79 if ( not $request->context->{resource} ) {
|
|
|
80 $request->context->{resource} = $this;
|
|
|
81 }
|
|
|
82
|
|
|
83 return _InvokeDelegate( $operation, $this, $request );
|
|
|
84 }
|
|
|
85
|
|
|
86 sub security {
|
|
|
87 shift->request->security
|
|
|
88 }
|
|
|
89
|
|
|
90 sub context {
|
|
|
91 shift->request->context
|
|
|
92 }
|
|
|
93
|
|
|
94 sub verbs {
|
|
|
95 {} # возвращаем пстой список операций
|
|
|
96 }
|
|
|
97
|
|
|
98 sub GetAllowedMethods {
|
|
|
99 map( uc, keys %{ shift->verbs } );
|
|
|
100 }
|
|
|
101
|
|
|
102 sub AccessCheck {
|
|
|
103
|
|
|
104 }
|
|
|
105
|
|
|
106 sub Seek {
|
|
|
107 my ($this, $role) = @_;
|
|
|
108
|
|
|
109 my @roles;
|
|
|
110
|
|
|
111 if (ref($role) eq 'ARRAY') {
|
|
|
112 @roles = @{$role};
|
|
|
113 } elsif (not ref($role)) {
|
|
|
114 @roles = split(/\s+/, $role);
|
|
|
115 } else {
|
|
|
116 die ArgumentException->new( role => 'A invalid value is provided, expected ARRAY or SCALAR');
|
|
|
117 }
|
|
|
118
|
|
|
119
|
|
|
120 for(my $r = $this; $r; $r = $r->parent) {
|
|
|
121 return $r if $r->HasRole(@roles);
|
|
|
122 }
|
|
|
123 return;
|
|
|
124 }
|
|
|
125
|
|
|
126 sub HasRole {
|
|
|
127 my ($this, @roles) = @_;
|
|
|
128 my %cache = map { $_, 1 } @{$this->role};
|
|
|
129 return scalar(grep not($cache{$_}), @roles) ? 0 : 1;
|
|
|
130 }
|
|
|
131
|
|
|
132 sub _InvokeDelegate {
|
|
|
133 my $delegate = shift;
|
|
|
134
|
|
|
135 return $delegate->(@_) if ref $delegate eq 'CODE';
|
|
|
136 return $delegate->Invoke(@_) if eval { $delegate->can('Invoke') };
|
|
|
137 }
|
|
|
138
|
|
|
139 1;
|
|
|
140
|
|
|
141 __END__
|
|
|
142
|
|
|
143 =pod
|
|
|
144
|
|
|
145 =head1 NAME
|
|
|
146
|
|
|
147 C<IMPL::Web::Application::Resource> - Web-ресурс.
|
|
|
148
|
|
|
149 =head1 SYNOPSIS
|
|
|
150
|
|
|
151 Класс для внутреннего использования. Объединяет в себе контракт и модель данных.
|
|
|
152 Основная задача - обработать поступающий от контроллера запрос на вызов C<HTTP>
|
|
|
153 метода.
|
|
|
154
|
|
|
155 Экземпляры данного класса передаются в качестве параметров делегатам
|
|
|
156 осуществляющим привязку к модели в C<IMPL::Web::Application::ResourceContract>
|
|
|
157 и C<IMPL::Web::Application::OperationContract>.
|
|
|
158
|
|
|
159 =head1 DESCRIPTION
|
|
|
160
|
|
|
161 Весь функционал ресурса, поддерживаемые им C<HTTP> методы определяются
|
|
|
162 контрактом. Однако можно реализовывать ресурсы, которые не имеют контракта
|
|
|
163 или он отличается от того, что предоставляется стандартно
|
|
|
164 C<IMPL::Web::Application::ResourceContract>.
|
|
|
165
|
|
|
166 Каждый ресурс является контейнером, тоесть позволяет получить дочерний ресурс
|
|
|
167 по идентифифкатору, если таковой имеется, тоесть ресурс, у которого нет дочерних
|
|
|
168 ресурсов на самом деле рассматривается как пустой контейнер.
|
|
|
169
|
|
|
170 С ресурсом непосредственно взаимодействует котроллер запросов
|
|
|
171 C<IMPL::Web::Handler::RestController>, вызывая два метода.
|
|
|
172
|
|
|
173 =over
|
|
|
174
|
|
|
175 =item * C<FetchChildResource($childId)>
|
|
|
176
|
|
|
177 Данный метод возвращает дочерний ресурс, соответствующий C<$childId>.
|
|
|
178 Текущая реализация использует метод C<FindChildResourceInfo> контракта текущего
|
|
|
179 ресурса, после чего создает дочерний ресурс.
|
|
|
180
|
|
|
181 Если дочерний ресурс не найден, вызывается исключение
|
|
|
182 C<IMPL::Web::NotFoundException>.
|
|
|
183
|
|
|
184 =item * C<InvokeHttpVerb($verb,$action)>
|
|
|
185
|
|
|
186 Обрабатывает запрос к ресурсу. Для этого используется контракт ресурса, в
|
|
|
187 нем выбирается соответсвующий C<IMPL::Web::Application::OperationContract>.
|
|
|
188 Затем найденный контракт для указанной операции используется для обработки
|
|
|
189 запроса.
|
|
|
190
|
|
|
191 =back
|
|
|
192
|
|
|
193 Если объект реализует два вышеуказанных метода, он является веб-ресурсом, а
|
|
|
194 детали его реализации, котнракт и прочее уже не важно, поэтому можно реализовать
|
|
|
195 собственный класс ресурса, например унаследованный от
|
|
|
196 C<IMPL::Web::Application::CustomResource>.
|
|
|
197
|
|
|
198 =head1 MEMBERS
|
|
|
199
|
|
|
200 =head2 C<[get]request>
|
|
|
201
|
|
|
202 Объект C<IMPL::Web::Application::Action> представляющий запрос к серверу.
|
|
|
203
|
|
|
204 =head2 C<[get]application>
|
|
|
205
|
|
|
206 Ссылка на приложение, к которому относится данный ресурс. Получается
|
|
|
207 автоматически из объекта запроса.
|
|
|
208
|
|
|
209 =head2 C<[get]contract>
|
|
|
210
|
|
|
211 Обязательное свойство для ресурса, ссылается, на контракт, соответствующий
|
|
|
212 данному ресурсу, используется для выполнения C<HTTP> методов и получения
|
|
|
213 дочерних ресурсов.
|
|
|
214
|
|
|
215 =head2 C<[get]id>
|
|
|
216
|
|
|
217 Обязательное свойство ресурса, идентифицирует его в родительском контейнере,
|
|
|
218 для корневого ресурса может иметь произвольное значение.
|
|
|
219
|
|
|
220 =head2 C<[get]parent>
|
|
|
221
|
|
|
222 Ссылка на родительский ресурс, для корневого ресурса не определена.
|
|
|
223
|
|
|
224 =head2 C<[get]model>
|
|
|
225
|
|
|
226 Ссылка на объект предметной области, представляемый данным ресурсом. Данное
|
|
|
227 свойство не является обязательным и может быть не задано.
|
|
|
228
|
|
|
229 =head2 C<[get]location>
|
|
|
230
|
|
|
231 Объект типа C<IMPL::Web::AutoLocator> или аналогичный описывающий адрес текущего
|
|
|
232 ресурса, может быть как явно передан при создании ресурса, так и вычислен
|
|
|
233 автоматически (только для ресурсов имеющих родителя). Следует заметить, что
|
|
|
234 адрес ресурса не содержит параметров запроса, а только путь.
|
|
|
235
|
|
|
236 =head2 C<[get,list]role>
|
|
|
237
|
|
|
238 Список ролей ресурса. Роль это условный маркер, который позволяет определить
|
|
|
239 функции выполняемые ресурсом, например контейнер, профиль пользователя и т.п.
|
|
|
240
|
|
|
241 Используется при построении цепочек навигации, а также при поиске с использованием
|
|
|
242 метода C<seek>.
|
|
|
243
|
|
|
244 =head2 C<seek($role)>
|
|
|
245
|
|
|
246 Ищет ресурс в цепочке родителей (включая сам ресурс) с подходящими ролями.
|
|
|
247
|
|
|
248 Роли могут быть переданы в виде массива или строки, где роли разделены пробелами
|
|
|
249
|
|
|
250 =head2 C<[get]FetchChildResource($id)>
|
|
|
251
|
|
|
252 Возвращает дочерний ресурс, по его идентификатору.
|
|
|
253
|
|
|
254 Данная реализация использует контракт текущего ресурса для поиска информации о
|
|
|
255 дочернем ресурсе C<< $this->contract->FindChildResourceInfo($id) >>.
|
|
|
256
|
|
|
257 Затем осуществляется привязка к моделе, тоесть, выполняется делегат, для
|
|
|
258 получения модели дочернего ресурса, а затем осуществляется привязка к контракту,
|
|
|
259 при этом в делегат, который должен вернуть контракт дочернего ресурса передаются
|
|
|
260 текущий ресурc и модель дочернего ресурса.
|
|
|
261
|
|
|
262 =cut
|
