Mercurial > pub > Impl
annotate Lib/IMPL/Web/Application.pm @ 214:4683002758aa
sync
| author | sergey |
|---|---|
| date | Mon, 06 Aug 2012 17:27:47 +0400 |
| parents | d6e2ea24af08 |
| children | 47f77e6409f7 |
| rev | line source |
|---|---|
| 49 | 1 package IMPL::Web::Application; |
| 2 use strict; | |
| 3 use warnings; | |
| 4 | |
| 198 | 5 use IMPL::lang qw(:declare :constants); |
| 6 use CGI; | |
| 7 use Carp qw(carp); | |
| 58 | 8 |
| 198 | 9 use IMPL::declare { |
| 10 require => { | |
| 11 TAction => 'IMPL::Web::Application::Action', | |
| 12 TResponse => 'IMPL::Web::Application::Response', | |
| 13 TFactory => '-IMPL::Object::Factory' | |
| 14 }, | |
| 15 base => { | |
| 16 'IMPL::Config' => '@_', | |
| 17 'IMPL::Object::Singleton' => '@_' | |
| 18 } | |
| 19 }; | |
| 49 | 20 |
| 198 | 21 BEGIN { |
| 213 | 22 public property errorHandler => PROP_ALL; |
| 198 | 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 } | |
|
60
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
59
diff
changeset
|
30 |
| 198 | 31 |
| 32 #TODO: remove | |
| 33 sub handlersQuery { | |
| 34 carp "handlersQuery is obsolete use handlers instead"; | |
| 35 goto &handlers; | |
| 36 } | |
| 170 | 37 |
| 49 | 38 |
| 62 | 39 sub CTOR { |
| 194 | 40 my ($this) = @_; |
| 41 | |
| 198 | 42 die IMPL::InvalidArgumentException->new("handlers","At least one handler should be supplied") unless $this->handlers->Count; |
| 43 | |
| 44 $this->actionFactory(TAction) unless $this->actionFactory; | |
| 194 | 45 $this->responseCharset('utf-8') unless $this->responseCharset; |
| 46 $this->fetchRequestMethod(\&defaultFetchRequest) unless $this->fetchRequestMethod; | |
| 213 | 47 $this->errorHandler(\&defaultErrorHandler) unless $this->errorHandler; |
| 62 | 48 } |
| 49 | |
| 49 | 50 sub Run { |
| 51 my ($this) = @_; | |
| 52 | |
| 198 | 53 my $handler; |
| 54 | |
| 55 $handler = _ChainHandler($_,$handler) foreach $this->handlers; | |
| 56 | |
| 58 | 57 while (my $query = $this->FetchRequest()) { |
| 58 | |
| 67 | 59 my $action = $this->actionFactory->new( |
| 194 | 60 query => $query, |
| 61 application => $this, | |
| 65 | 62 ); |
| 63 | |
| 97 | 64 eval { |
| 194 | 65 $action->response->charset($this->responseCharset); |
| 66 | |
| 198 | 67 $handler->($action); |
| 194 | 68 |
| 69 $action->response->Complete; | |
| 97 | 70 }; |
| 71 if ($@) { | |
| 194 | 72 my $e = $@; |
| 73 # we are expecting this method to be safe otherwise we can trust nothing in this wolrd | |
| 213 | 74 $this->errorHandler()->($this,$action,$e); |
| 97 | 75 } |
| 49 | 76 } |
| 77 } | |
| 78 | |
| 198 | 79 sub _ChainHandler { |
| 80 my ($handler,$next) = @_; | |
| 81 | |
| 82 if (ref $handler eq 'CODE') { | |
| 83 return sub { | |
| 84 my ($action) = @_; | |
| 85 return $handler->($action,$next); | |
| 86 }; | |
| 87 } elsif (eval { $handler->can('Invoke') } ) { | |
| 88 return sub { | |
| 89 my ($action) = @_; | |
| 90 return $handler->Invoke($action,$next); | |
| 91 }; | |
| 92 } elsif (eval{ $handler->isa(TFactory) }) { | |
| 93 return sub { | |
| 94 my ($action) = @_; | |
| 95 my $inst = $handler->new(); | |
| 96 return $inst->Invoke($action,$next); | |
| 97 } | |
| 98 } elsif ($handler and not ref $handler and $handler =~ m/^(-)?(\w+(?:::\w+)*)$/) { | |
| 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 { | |
| 109 my ($action) = @_; | |
| 110 my $inst = $class->new(); | |
| 111 return $inst->Invoke($action,$next); | |
| 112 }; | |
| 113 } else { | |
| 114 die new IMPL::InvalidArgumentException("An invalid handler supplied",$handler); | |
| 115 } | |
| 116 } | |
| 117 | |
| 97 | 118 sub FetchRequest { |
| 194 | 119 my ($this) = @_; |
| 120 | |
| 121 if( ref $this->fetchRequestMethod eq 'CODE' ) { | |
| 122 return $this->fetchRequestMethod->($this); | |
| 123 } else { | |
| 124 die new IMPL::Exception("Unknown fetchRequestMethod type",ref $this->fetchRequestMethod); | |
| 125 } | |
| 97 | 126 } |
| 127 | |
| 57 | 128 { |
| 194 | 129 my $hasFetched = 0; |
| 57 | 130 |
| 194 | 131 sub defaultFetchRequest { |
| 132 my ($this) = @_; | |
| 133 return undef if $hasFetched; | |
| 134 $hasFetched = 1; | |
| 135 my $query = CGIWrapper->new(); | |
| 136 $query->charset($this->responseCharset); | |
| 137 return $query; | |
| 138 } | |
| 57 | 139 } |
| 140 | |
| 213 | 141 sub defaultErrorHandler { |
| 194 | 142 my ($this,$action,$e) = @_; |
| 143 warn $e; | |
| 144 if ( eval { $action->ReinitResponse(); 1; } ) { | |
| 145 $action->response->contentType('text/plain'); | |
| 146 $action->response->charset($this->responseCharset); | |
| 147 $action->response->status(500); | |
| 148 my $hout = $action->response->streamBody; | |
| 149 print $hout $e; | |
| 150 $action->response->Complete(); | |
| 151 } | |
| 97 | 152 } |
| 153 | |
|
130
06a34c197b05
Added support for utf-8 and old versions of CGI module
wizard
parents:
129
diff
changeset
|
154 package CGIWrapper; |
| 166 | 155 use parent qw(CGI); |
|
130
06a34c197b05
Added support for utf-8 and old versions of CGI module
wizard
parents:
129
diff
changeset
|
156 |
|
06a34c197b05
Added support for utf-8 and old versions of CGI module
wizard
parents:
129
diff
changeset
|
157 use Encode; |
|
06a34c197b05
Added support for utf-8 and old versions of CGI module
wizard
parents:
129
diff
changeset
|
158 |
| 138 | 159 our $NO_DECODE = 0; |
| 160 | |
|
130
06a34c197b05
Added support for utf-8 and old versions of CGI module
wizard
parents:
129
diff
changeset
|
161 sub param { |
| 194 | 162 my $this = shift; |
| 163 | |
| 164 return $this->SUPER::param(@_) if $NO_DECODE; | |
| 165 | |
| 166 if (wantarray) { | |
| 167 my @result = $this->SUPER::param(@_); | |
| 168 | |
| 169 return map Encode::is_utf8($_) ? $_ : Encode::decode($this->charset,$_,Encode::LEAVE_SRC), @result; | |
| 170 } else { | |
| 171 my $result = $this->SUPER::param(@_); | |
| 172 | |
| 173 return Encode::is_utf8($result) ? $result : Encode::decode($this->charset,$result,Encode::LEAVE_SRC); | |
| 174 } | |
|
130
06a34c197b05
Added support for utf-8 and old versions of CGI module
wizard
parents:
129
diff
changeset
|
175 |
|
06a34c197b05
Added support for utf-8 and old versions of CGI module
wizard
parents:
129
diff
changeset
|
176 } |
|
06a34c197b05
Added support for utf-8 and old versions of CGI module
wizard
parents:
129
diff
changeset
|
177 |
| 138 | 178 sub upload { |
| 194 | 179 my $this = shift; |
| 180 | |
| 181 local $NO_DECODE = 1; | |
| 182 my $oldCharset = $this->charset(); | |
| 183 $this->charset('ISO-8859-1'); | |
| 184 | |
| 185 my $fh = $this->SUPER::upload(@_); | |
| 186 | |
| 187 $this->charset($oldCharset); | |
| 188 return $fh; | |
| 138 | 189 } |
| 190 | |
| 49 | 191 1; |
| 192 | |
| 52 | 193 __END__ |
| 194 | |
| 49 | 195 =pod |
| 196 | |
| 197 =head1 SYNOPSIS | |
| 198 | |
| 67 | 199 =begin code |
| 200 | |
| 49 | 201 require MyApp; |
| 67 | 202 |
| 203 my $instance = spawn MyApp('app.config'); | |
| 204 | |
| 205 $instance->Run(); | |
| 206 | |
| 207 =end code | |
| 49 | 208 |
| 209 =head1 DESCRIPTION | |
| 210 | |
| 213 | 211 C< inherits IMPL::Config, IMPL::Object::Singleton > |
| 73 | 212 |
| 180 | 213 Зкземпляр приложения содержит в себе глобальные настройки, реализует контроллер запросов, |
| 214 в качестве источника запросов используется CGI или иной совместимый модуль. | |
| 49 | 215 |
| 180 | 216 Процесс обработки запроса состоит из следующих частей |
| 49 | 217 |
| 67 | 218 =over |
| 219 | |
| 220 =item 1 | |
| 221 | |
| 180 | 222 Получение cgi запроса |
| 67 | 223 |
| 224 =item 2 | |
| 52 | 225 |
| 180 | 226 Создание объекта C<IMPL::Web::Application::Action> |
| 52 | 227 |
| 67 | 228 =item 3 |
| 52 | 229 |
| 180 | 230 Формирование цепочки вызовов при помощи C<< IMPL::Web::Application::Action->ChainHandler >> |
| 67 | 231 |
| 232 =item 4 | |
| 233 | |
| 180 | 234 Выполнение запроса C<< IMPL::Web::Application::Action->Invoke >> |
| 49 | 235 |
| 236 =cut | |
| 67 | 237 |
| 180 | 238 Также приложение поддерживает отложенное создание объектов, которые по первому обращению |
| 239 к свойствам. Это реализовано в базовом классе C< IMPL::Configuration >. Для настройки | |
| 240 активаторов можно использовать свойство C<options>, в которое должен быть помещен хеш | |
| 241 со ссылками на активаторы, см. пример ниже C<CONFIGURATION>. | |
| 67 | 242 |
| 243 =head2 CONFIGURATION | |
| 244 | |
| 180 | 245 Ниже приведен пример конфигурации приложения |
| 67 | 246 |
| 247 =begin code xml | |
| 248 | |
| 249 <?xml version="1.0" encoding="UTF-8"?> | |
| 250 <Application id='app' type="Test::Web::Application::Instance"> | |
| 194 | 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> | |
| 67 | 305 </Application> |
| 306 | |
| 307 =end code xml | |
| 308 | |
| 73 | 309 =head1 MEMBERS |
| 310 | |
| 311 =over | |
| 312 | |
| 213 | 313 =item C<[get,set] errorHandler> |
| 73 | 314 |
| 180 | 315 Обработчик который будет вызван в случае возникновения необработанной ошибки |
| 316 в процессе работы приложения. После чего приложение корректно завершается. | |
| 73 | 317 |
| 318 =item C<[get,set] actionFactory> | |
| 319 | |
| 180 | 320 Фабрика объектов, которая используется приложением, для создания объектов |
| 321 типа C<IMPL::Web::Application::Action> при обработки C<CGI> запросов. | |
| 73 | 322 |
| 323 =begin code | |
| 324 | |
| 325 my $action = $this->actionFactory->new( | |
| 326 query => $query, | |
| 327 application => $this, | |
| 328 ); | |
| 329 | |
| 330 =end code | |
| 331 | |
| 97 | 332 =item C< [get,set] fetchRequestMethod > |
| 333 | |
| 180 | 334 Метод получения CGI запроса. Возвращает C<CGI> объект следующего запроса, если |
| 335 запросов больше нет, то возвращает C<undef>. По-умолчанию использует C<defaultFetchRequest>. | |
| 97 | 336 |
| 180 | 337 Может быть как ссылкой на функцию, так и объектом типа C<IMPL::Web::Application::RequestFetcher>. |
| 97 | 338 |
| 73 | 339 =item C< [get,set,list] handlersQuery > |
| 340 | |
| 180 | 341 Список обработчиков запросов, которые будут переданы созданному объекту-действию. |
| 73 | 342 |
| 343 =item C< [get,set] responseCharset> | |
| 344 | |
| 180 | 345 Кодировка ответа клиенту. |
| 73 | 346 |
| 347 =item C< [get,set] security > | |
| 348 | |
| 180 | 349 Объект C<IMPL::Web::Security>, для работы с инфраструктурой безопасности. |
| 73 | 350 |
| 351 =item C< [get,set] options > | |
| 352 | |
| 180 | 353 Обычно ссылка на хеш с настраиваемыми объектами, используется для возможности |
| 354 програмной настройки активаторов, т.к. напрямую через свойства приложения получить | |
| 355 к ним доступ не получится. | |
| 73 | 356 |
| 357 =back | |
| 358 | |
| 180 | 359 =cut |