Mercurial > pub > Impl

comparison Lib/IMPL/Web/Application.pm @ 229:47f77e6409f7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
heavily reworked the resource model of the web application: *some ResourcesContraact functionality moved to Resource +Added CustomResource *Corrected action handlers
author sergey
date Sat, 29 Sep 2012 02:34:47 +0400
parents d6e2ea24af08
children 6d8092d8ce1b
comparison
equal deleted inserted replaced
228:431db7034a88 229:47f77e6409f7
6 use CGI; 6 use CGI;
7 use Carp qw(carp); 7 use Carp qw(carp);
8 8
9 use IMPL::declare { 9 use IMPL::declare {
10 require => { 10 require => {
11 TAction => 'IMPL::Web::Application::Action', 11 TAction => 'IMPL::Web::Application::Action',
12 TResponse => 'IMPL::Web::Application::Response', 12 HttpResponse => 'IMPL::Web::HttpResponse',
13 TFactory => '-IMPL::Object::Factory' 13 TFactory => '-IMPL::Object::Factory',
14 }, 14 Exception => 'IMPL::Exception',
15 base => { 15 InvalidOperationException => 'IMPL::InvalidOperationException',
16 'IMPL::Config' => '@_', 16 Loader => 'IMPL::Code::Loader'
17 },
18 base => [
19 'IMPL::Config' => '@_',
17 'IMPL::Object::Singleton' => '@_' 20 'IMPL::Object::Singleton' => '@_'
18 } 21 ],
22 props => [
23 actionFactory => PROP_ALL,
24 handlers => PROP_ALL | PROP_LIST,
25 security => PROP_ALL,
26 options => PROP_ALL,
27 fetchRequestMethod => PROP_ALL,
28 output => PROP_ALL
29 ]
19 }; 30 };
20 31
21 BEGIN {
22 public property errorHandler => PROP_ALL;
23 public property actionFactory => PROP_ALL;
24 public property handlers => PROP_ALL | PROP_LIST;
25 public property responseCharset => PROP_ALL;
26 public property security => PROP_ALL;
27 public property options => PROP_ALL;
28 public property fetchRequestMethod => PROP_ALL;
29 }
30
31
32 #TODO: remove
33 sub handlersQuery {
34 carp "handlersQuery is obsolete use handlers instead";
35 goto &handlers;
36 }
37
38
39 sub CTOR { 32 sub CTOR {
40 my ($this) = @_; 33 my ($this) = @_;
41 34
42 die IMPL::InvalidArgumentException->new("handlers","At least one handler should be supplied") unless $this->handlers->Count; 35 die IMPL::InvalidArgumentException->new( "handlers",
43 36 "At least one handler should be supplied" )
44 $this->actionFactory(TAction) unless $this->actionFactory; 37 unless $this->handlers->Count;
45 $this->responseCharset('utf-8') unless $this->responseCharset; 38
46 $this->fetchRequestMethod(\&defaultFetchRequest) unless $this->fetchRequestMethod; 39 $this->actionFactory(TAction) unless $this->actionFactory;
47 $this->errorHandler(\&defaultErrorHandler) unless $this->errorHandler; 40 $this->fetchRequestMethod( \&defaultFetchRequest )
41 unless $this->fetchRequestMethod;
48 } 42 }
49 43
50 sub Run { 44 sub Run {
51 my ($this) = @_; 45 my ($this) = @_;
52 46
53 my $handler; 47 my $handler;
54 48
55 $handler = _ChainHandler($_,$handler) foreach $this->handlers; 49 $handler = _ChainHandler( $_, $handler ) foreach $this->handlers;
56 50
57 while (my $query = $this->FetchRequest()) { 51 while ( my $query = $this->FetchRequest() ) {
58 52
59 my $action = $this->actionFactory->new( 53 my $action = $this->actionFactory->new(
60 query => $query, 54 query => $query,
61 application => $this, 55 application => $this,
62 ); 56 );
63 57
64 eval { 58 eval {
65 $action->response->charset($this->responseCharset); 59 my $result = $handler->($action);
66 60
67 $handler->($action); 61 die InvalidOperationException->new(
68 62 "Invalid handlers result. A reference to IMPL::Web::HttpResponse is expexted."
69 $action->response->Complete; 63 ) unless eval { $result->isa(HttpResponse) };
70 }; 64
71 if ($@) { 65 $result->PrintResponse( $this->output );
72 my $e = $@; 66 };
73 # we are expecting this method to be safe otherwise we can trust nothing in this wolrd 67 if ($@) {
74 $this->errorHandler()->($this,$action,$e); 68 my $e = $@;
75 } 69
76 } 70 HttpResponse->InternalError(
71 type => 'text/plain',
72 charset => 'utf-8',
73 body => $e
74 )->PrintResponse( $this->output );
75
76 }
77 }
77 } 78 }
78 79
79 sub _ChainHandler { 80 sub _ChainHandler {
80 my ($handler,$next) = @_; 81 my ( $handler, $next ) = @_;
81 82
82 if (ref $handler eq 'CODE') { 83 if ( ref $handler eq 'CODE' ) {
83 return sub { 84 return sub {
84 my ($action) = @_; 85 my ($action) = @_;
85 return $handler->($action,$next); 86 return $handler->( $action, $next );
86 }; 87 };
87 } elsif (eval { $handler->can('Invoke') } ) { 88 }
88 return sub { 89 elsif ( eval { $handler->can('Invoke') } ) {
89 my ($action) = @_; 90 return sub {
90 return $handler->Invoke($action,$next); 91 my ($action) = @_;
91 }; 92 return $handler->Invoke( $action, $next );
92 } elsif (eval{ $handler->isa(TFactory) }) { 93 };
94 }
95 elsif ( eval { $handler->isa(TFactory) } ) {
93 return sub { 96 return sub {
94 my ($action) = @_; 97 my ($action) = @_;
95 my $inst = $handler->new(); 98 my $inst = $handler->new();
96 return $inst->Invoke($action,$next); 99 return $inst->Invoke( $action, $next );
100 }
101 }
102 elsif ( $handler
103 and not ref $handler
104 and $handler =~ m/^(-)?(\w+(?:::\w+)*)$/ )
105 {
106 my $class = $2;
107 if ( not $1 ) {
108 Loader->safe->Require($class);
109 die IMPL::InvalidArgumentException->(
110 "An invalid handler supplied", $handler
111 ) unless $class->can('Invoke');
97 } 112 }
98 } elsif ($handler and not ref $handler and $handler =~ m/^(-)?(\w+(?:::\w+)*)$/) { 113
99 my $class = $2;
100 if (not $1) {
101 my $mod = $class;
102 $mod =~ s/::/\//g;
103 require "$mod.pm";
104
105 die IMPL::InvalidArgumentException->("An invalid handler supplied",$handler) unless $class->can('Invoke');
106 }
107
108 return sub { 114 return sub {
109 my ($action) = @_; 115 my ($action) = @_;
110 my $inst = $class->new(); 116 my $inst = $class->new();
111 return $inst->Invoke($action,$next); 117 return $inst->Invoke( $action, $next );
112 }; 118 };
113 } else { 119 }
114 die new IMPL::InvalidArgumentException("An invalid handler supplied",$handler); 120 else {
121 die new IMPL::InvalidArgumentException( "An invalid handler supplied",
122 $handler );
115 } 123 }
116 } 124 }
117 125
118 sub FetchRequest { 126 sub FetchRequest {
119 my ($this) = @_; 127 my ($this) = @_;
120 128
121 if( ref $this->fetchRequestMethod eq 'CODE' ) { 129 if ( ref $this->fetchRequestMethod eq 'CODE' ) {
122 return $this->fetchRequestMethod->($this); 130 return $this->fetchRequestMethod->($this);
123 } else { 131 }
124 die new IMPL::Exception("Unknown fetchRequestMethod type",ref $this->fetchRequestMethod); 132 else {
125 } 133 die new IMPL::Exception(
134 "Unknown fetchRequestMethod type",
135 ref $this->fetchRequestMethod
136 );
137 }
126 } 138 }
127 139
128 { 140 {
129 my $hasFetched = 0; 141 my $hasFetched = 0;
130 142
131 sub defaultFetchRequest { 143 sub defaultFetchRequest {
132 my ($this) = @_; 144 my ($this) = @_;
133 return undef if $hasFetched; 145 return undef if $hasFetched;
134 $hasFetched = 1; 146 $hasFetched = 1;
135 my $query = CGIWrapper->new(); 147 $this->output(*STDOUT);
136 $query->charset($this->responseCharset); 148 my $query = CGIWrapper->new();
137 return $query; 149 return $query;
138 } 150 }
139 } 151 }
140 152
141 sub defaultErrorHandler { 153 sub defaultErrorHandler {
142 my ($this,$action,$e) = @_; 154 my ( $this, $action, $e ) = @_;
143 warn $e; 155 warn $e;
144 if ( eval { $action->ReinitResponse(); 1; } ) { 156 if ( eval { $action->ReinitResponse(); 1; } ) {
145 $action->response->contentType('text/plain'); 157 $action->response->contentType('text/plain');
146 $action->response->charset($this->responseCharset); 158 $action->response->charset( $this->responseCharset );
147 $action->response->status(500); 159 $action->response->status(500);
148 my $hout = $action->response->streamBody; 160 my $hout = $action->response->streamBody;
149 print $hout $e; 161 print $hout $e;
150 $action->response->Complete(); 162 $action->response->Complete();
151 } 163 }
152 } 164 }
153 165
154 package CGIWrapper; 166 package CGIWrapper;
155 use parent qw(CGI); 167 use parent qw(CGI);
156 168
157 use Encode; 169 use Encode;
158 170
159 our $NO_DECODE = 0; 171 our $NO_DECODE = 0;
160 172
161 sub param { 173 sub param {
162 my $this = shift; 174 my $this = shift;
163 175
164 return $this->SUPER::param(@_) if $NO_DECODE; 176 return $this->SUPER::param(@_) if $NO_DECODE;
165 177
166 if (wantarray) { 178 if (wantarray) {
167 my @result = $this->SUPER::param(@_); 179 my @result = $this->SUPER::param(@_);
168 180
169 return map Encode::is_utf8($_) ? $_ : Encode::decode($this->charset,$_,Encode::LEAVE_SRC), @result; 181 return map Encode::is_utf8($_)
170 } else { 182 ? $_
171 my $result = $this->SUPER::param(@_); 183 : Encode::decode( $this->charset, $_, Encode::LEAVE_SRC ), @result;
172 184 }
173 return Encode::is_utf8($result) ? $result : Encode::decode($this->charset,$result,Encode::LEAVE_SRC); 185 else {
174 } 186 my $result = $this->SUPER::param(@_);
187
188 return Encode::is_utf8($result)
189 ? $result
190 : Encode::decode( $this->charset, $result, Encode::LEAVE_SRC );
191 }
175 192
176 } 193 }
177 194
178 sub upload { 195 sub upload {
179 my $this = shift; 196 my $this = shift;
180 197
181 local $NO_DECODE = 1; 198 local $NO_DECODE = 1;
182 my $oldCharset = $this->charset(); 199 my $oldCharset = $this->charset();
183 $this->charset('ISO-8859-1'); 200 $this->charset('ISO-8859-1');
184 201
185 my $fh = $this->SUPER::upload(@_); 202 my $fh = $this->SUPER::upload(@_);
186 203
187 $this->charset($oldCharset); 204 $this->charset($oldCharset);
188 return $fh; 205 return $fh;
189 } 206 }
190 207
191 1; 208 1;
192 209
193 __END__ 210 __END__
194 211
195 =pod 212 =pod
196 213
214 =head1 NAME
215
216 C<IMPL::Web::Application> Класс для создания экземпляров приложения
217
197 =head1 SYNOPSIS 218 =head1 SYNOPSIS
198 219
199 =begin code 220 =begin code
200 221
201 require MyApp; 222 use IMPL::require {
202 223 App => 'IMPL::Web::Application'
203 my $instance = spawn MyApp('app.config'); 224 };
204 225
205 $instance->Run(); 226 my $instance = App->spawn(); # will use ./IMPL/Web/Application.xml as configuration
227
228 $instance->Run;
206 229
207 =end code 230 =end code
208 231
209 =head1 DESCRIPTION 232 =head1 DESCRIPTION
210 233
211 C< inherits IMPL::Config, IMPL::Object::Singleton > 234 Создает экземпляр объекта, который получает и обрабатывает C<HTTP> запрос.
212 235 Приложение можно загрузить из C<xml> файла в котором описано состояние свойств,
213 Зкземпляр приложения содержит в себе глобальные настройки, реализует контроллер запросов, 236 для этого используется механизм C<IMPL::Serialization>.
214 в качестве источника запросов используется CGI или иной совместимый модуль. 237
215 238 Приложение представлет собой модульную конструкцию, которая состоит из цепочки
216 Процесс обработки запроса состоит из следующих частей 239 обработчиков. Цепочка обработчиков вызывается снизу вверх, при этом каждый
217 240 обработчик самостоятельно рекурсивно вызывает следующий (более высокого уровня).
218 =over
219
220 =item 1
221
222 Получение cgi запроса
223
224 =item 2
225
226 Создание объекта C<IMPL::Web::Application::Action>
227
228 =item 3
229
230 Формирование цепочки вызовов при помощи C<< IMPL::Web::Application::Action->ChainHandler >>
231
232 =item 4
233
234 Выполнение запроса C<< IMPL::Web::Application::Action->Invoke >>
235 241
236 =cut 242 =cut
237
238 Также приложение поддерживает отложенное создание объектов, которые по первому обращению
239 к свойствам. Это реализовано в базовом классе C< IMPL::Configuration >. Для настройки
240 активаторов можно использовать свойство C<options>, в которое должен быть помещен хеш
241 со ссылками на активаторы, см. пример ниже C<CONFIGURATION>.
242
243 =head2 CONFIGURATION
244
245 Ниже приведен пример конфигурации приложения
246
247 =begin code xml
248
249 <?xml version="1.0" encoding="UTF-8"?>
250 <Application id='app' type="Test::Web::Application::Instance">
251
252 <!-- Begin custom properties -->
253 <name>Sample application</name>
254 <dataSource type='IMPL::Config::Activator' id='ds'>
255 <factory>IMPL::Object</factory>
256 <parameters type='HASH'>
257 <db>data</db>
258 <user>nobody</user>
259 </parameters>
260 </dataSource>
261 <securityMod type='IMPL::Config::Activator'>
262 <factory>IMPL::Object</factory>
263 <parameters type='HASH'>
264 <ds refid='ds'/>
265 </parameters>
266 </securityMod>
267 <!-- End custom properties -->
268
269 <!-- direct access to the activators -->
270 <options type="HASH">
271 <dataSource refid='ds'/>
272 </options>
273
274 <!-- Set default output encoding, can be changed due query handling -->
275 <responseCharset>utf-8</responseCharset>
276
277 <!-- Actions creation configuration -->
278 <actionFactory type="IMPL::Object::Factory">
279
280 <!-- Construct actions -->
281 <factory>IMPL::Web::Application::Action</factory>
282 <parameters type='HASH'>
283
284 <!-- with special responseFactory -->
285 <responseFactory type='IMPL::Object::Factory'>
286
287 <!-- Where resopnses have a special streamOut -->
288 <factory>IMPL::Web::Application::Response</factory>
289 <parameters type='HASH'>
290
291 <!-- in memory dummy output instead of STDOUT -->
292 <streamOut>memory</streamOut>
293
294 </parameters>
295 </responseFactory>
296 </parameters>
297 </actionFactory>
298
299 <!-- Query processing chain -->
300 <handlersQuery type="IMPL::Object::List">
301 <item type="IMPL::Web::QueryHandler::PageFormat">
302 <templatesCharset>cp1251</templatesCharset>
303 </item>
304 </handlersQuery>
305 </Application>
306
307 =end code xml
308
309 =head1 MEMBERS
310
311 =over
312
313 =item C<[get,set] errorHandler>
314
315 Обработчик который будет вызван в случае возникновения необработанной ошибки
316 в процессе работы приложения. После чего приложение корректно завершается.
317
318 =item C<[get,set] actionFactory>
319
320 Фабрика объектов, которая используется приложением, для создания объектов
321 типа C<IMPL::Web::Application::Action> при обработки C<CGI> запросов.
322
323 =begin code
324
325 my $action = $this->actionFactory->new(
326 query => $query,
327 application => $this,
328 );
329
330 =end code
331
332 =item C< [get,set] fetchRequestMethod >
333
334 Метод получения CGI запроса. Возвращает C<CGI> объект следующего запроса, если
335 запросов больше нет, то возвращает C<undef>. По-умолчанию использует C<defaultFetchRequest>.
336
337 Может быть как ссылкой на функцию, так и объектом типа C<IMPL::Web::Application::RequestFetcher>.
338
339 =item C< [get,set,list] handlersQuery >
340
341 Список обработчиков запросов, которые будут переданы созданному объекту-действию.
342
343 =item C< [get,set] responseCharset>
344
345 Кодировка ответа клиенту.
346
347 =item C< [get,set] security >
348
349 Объект C<IMPL::Web::Security>, для работы с инфраструктурой безопасности.
350
351 =item C< [get,set] options >
352
353 Обычно ссылка на хеш с настраиваемыми объектами, используется для возможности
354 програмной настройки активаторов, т.к. напрямую через свойства приложения получить
355 к ним доступ не получится.
356
357 =back
358
359 =cut