Mercurial > pub > Impl
annotate Lib/IMPL/Web/Application.pm @ 189:08015e2803f1
IMPL::Vew::Web - fixed memory leaks, more tests
| author | cin |
|---|---|
| date | Wed, 04 Apr 2012 02:49:45 +0400 |
| parents | d1676be8afcc |
| children | 4d0e1962161c |
| rev | line source |
|---|---|
| 49 | 1 package IMPL::Web::Application; |
| 2 use strict; | |
| 3 use warnings; | |
| 4 | |
| 166 | 5 use parent qw(IMPL::Config IMPL::Object::Singleton); |
| 58 | 6 |
| 7 require IMPL::Web::Application::Action; | |
| 8 require IMPL::Web::Application::Response; | |
| 9 | |
| 49 | 10 use IMPL::Class::Property; |
| 57 | 11 use CGI; |
| 49 | 12 |
|
60
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
59
diff
changeset
|
13 __PACKAGE__->PassThroughArgs; |
|
b0c068da93ac
Lazy activation for the configuration objects (final concept)
wizard
parents:
59
diff
changeset
|
14 |
| 170 | 15 public property handlerError => prop_all; |
| 16 public property actionFactory => prop_all; | |
| 17 public property handlersQuery => prop_all | prop_list; | |
| 18 public property responseCharset => prop_all; | |
| 19 public property security => prop_all; | |
| 20 public property options => prop_all; | |
| 21 public property fetchRequestMethod => prop_all; | |
| 22 | |
| 49 | 23 |
| 62 | 24 sub CTOR { |
| 25 my ($this) = @_; | |
| 26 | |
| 170 | 27 $this->actionFactory(typeof IMPL::Web::Application::Action) unless $this->actionFactory; |
| 65 | 28 $this->responseCharset('utf-8') unless $this->responseCharset; |
| 97 | 29 $this->fetchRequestMethod(\&defaultFetchRequest) unless $this->fetchRequestMethod; |
| 30 $this->handlerError(\&defaultHandlerError) unless $this->handlerError; | |
| 62 | 31 } |
| 32 | |
| 49 | 33 sub Run { |
| 34 my ($this) = @_; | |
| 35 | |
| 58 | 36 while (my $query = $this->FetchRequest()) { |
| 37 | |
| 67 | 38 my $action = $this->actionFactory->new( |
| 62 | 39 query => $query, |
| 58 | 40 application => $this, |
| 65 | 41 ); |
| 42 | |
| 97 | 43 eval { |
| 44 $action->response->charset($this->responseCharset); | |
| 45 | |
| 46 $action->ChainHandler($_) foreach $this->handlersQuery; | |
| 47 | |
| 48 $action->Invoke(); | |
| 49 | |
| 50 $action->response->Complete; | |
| 51 }; | |
| 52 if ($@) { | |
|
99
6dd659f6f66c
Minor changes, DOM schema is in development (in the aspect of a forms)
wizard
parents:
97
diff
changeset
|
53 my $e = $@; |
| 129 | 54 # we are expecting this method to be safe otherwise we can trust nothing in this wolrd |
|
99
6dd659f6f66c
Minor changes, DOM schema is in development (in the aspect of a forms)
wizard
parents:
97
diff
changeset
|
55 $this->handlerError()->($this,$action,$e); |
| 97 | 56 } |
| 49 | 57 } |
| 58 } | |
| 59 | |
| 97 | 60 sub FetchRequest { |
| 61 my ($this) = @_; | |
| 62 | |
| 63 if( ref $this->fetchRequestMethod eq 'CODE' ) { | |
| 64 return $this->fetchRequestMethod->($this); | |
| 65 } else { | |
| 66 die new IMPL::Exception("Unknown fetchRequestMethod type",ref $this->fetchRequestMethod); | |
| 67 } | |
| 68 } | |
| 69 | |
| 57 | 70 { |
| 71 my $hasFetched = 0; | |
| 72 | |
| 97 | 73 sub defaultFetchRequest { |
| 129 | 74 my ($this) = @_; |
| 57 | 75 return undef if $hasFetched; |
| 76 $hasFetched = 1; | |
|
130
06a34c197b05
Added support for utf-8 and old versions of CGI module
wizard
parents:
129
diff
changeset
|
77 my $query = CGIWrapper->new(); |
| 129 | 78 $query->charset($this->responseCharset); |
| 79 return $query; | |
| 57 | 80 } |
| 81 } | |
| 82 | |
| 97 | 83 sub defaultHandlerError { |
| 84 my ($this,$action,$e) = @_; | |
| 85 warn $e; | |
| 86 if ( eval { $action->ReinitResponse(); 1; } ) { | |
| 87 $action->response->contentType('text/plain'); | |
| 88 $action->response->charset($this->responseCharset); | |
| 89 $action->response->status(500); | |
| 90 my $hout = $action->response->streamBody; | |
| 91 print $hout $e; | |
| 92 $action->response->Complete(); | |
| 93 } | |
| 94 } | |
| 95 | |
|
130
06a34c197b05
Added support for utf-8 and old versions of CGI module
wizard
parents:
129
diff
changeset
|
96 package CGIWrapper; |
| 166 | 97 use parent qw(CGI); |
|
130
06a34c197b05
Added support for utf-8 and old versions of CGI module
wizard
parents:
129
diff
changeset
|
98 |
|
06a34c197b05
Added support for utf-8 and old versions of CGI module
wizard
parents:
129
diff
changeset
|
99 use Encode; |
|
06a34c197b05
Added support for utf-8 and old versions of CGI module
wizard
parents:
129
diff
changeset
|
100 |
| 138 | 101 our $NO_DECODE = 0; |
| 102 | |
|
130
06a34c197b05
Added support for utf-8 and old versions of CGI module
wizard
parents:
129
diff
changeset
|
103 sub param { |
|
06a34c197b05
Added support for utf-8 and old versions of CGI module
wizard
parents:
129
diff
changeset
|
104 my $this = shift; |
|
06a34c197b05
Added support for utf-8 and old versions of CGI module
wizard
parents:
129
diff
changeset
|
105 |
| 138 | 106 return $this->SUPER::param(@_) if $NO_DECODE; |
| 107 | |
|
130
06a34c197b05
Added support for utf-8 and old versions of CGI module
wizard
parents:
129
diff
changeset
|
108 if (wantarray) { |
|
06a34c197b05
Added support for utf-8 and old versions of CGI module
wizard
parents:
129
diff
changeset
|
109 my @result = $this->SUPER::param(@_); |
|
06a34c197b05
Added support for utf-8 and old versions of CGI module
wizard
parents:
129
diff
changeset
|
110 |
|
06a34c197b05
Added support for utf-8 and old versions of CGI module
wizard
parents:
129
diff
changeset
|
111 return map Encode::is_utf8($_) ? $_ : Encode::decode($this->charset,$_,Encode::LEAVE_SRC), @result; |
|
06a34c197b05
Added support for utf-8 and old versions of CGI module
wizard
parents:
129
diff
changeset
|
112 } else { |
|
06a34c197b05
Added support for utf-8 and old versions of CGI module
wizard
parents:
129
diff
changeset
|
113 my $result = $this->SUPER::param(@_); |
|
06a34c197b05
Added support for utf-8 and old versions of CGI module
wizard
parents:
129
diff
changeset
|
114 |
|
06a34c197b05
Added support for utf-8 and old versions of CGI module
wizard
parents:
129
diff
changeset
|
115 return Encode::is_utf8($result) ? $result : Encode::decode($this->charset,$result,Encode::LEAVE_SRC); |
|
06a34c197b05
Added support for utf-8 and old versions of CGI module
wizard
parents:
129
diff
changeset
|
116 } |
|
06a34c197b05
Added support for utf-8 and old versions of CGI module
wizard
parents:
129
diff
changeset
|
117 |
|
06a34c197b05
Added support for utf-8 and old versions of CGI module
wizard
parents:
129
diff
changeset
|
118 } |
|
06a34c197b05
Added support for utf-8 and old versions of CGI module
wizard
parents:
129
diff
changeset
|
119 |
| 138 | 120 sub upload { |
| 121 my $this = shift; | |
| 122 | |
| 123 local $NO_DECODE = 1; | |
| 124 my $oldCharset = $this->charset(); | |
| 125 $this->charset('ISO-8859-1'); | |
| 126 | |
| 127 my $fh = $this->SUPER::upload(@_); | |
| 128 | |
| 129 $this->charset($oldCharset); | |
| 130 return $fh; | |
| 131 } | |
| 132 | |
| 49 | 133 1; |
| 134 | |
| 52 | 135 __END__ |
| 136 | |
| 49 | 137 =pod |
| 138 | |
| 139 =head1 SYNOPSIS | |
| 140 | |
| 67 | 141 =begin code |
| 142 | |
| 49 | 143 require MyApp; |
| 67 | 144 |
| 145 my $instance = spawn MyApp('app.config'); | |
| 146 | |
| 147 $instance->Run(); | |
| 148 | |
| 149 =end code | |
| 49 | 150 |
| 151 =head1 DESCRIPTION | |
| 152 | |
| 166 | 153 C< use parent qw( IMPL::Config IMPL::Object::Singleton )> |
| 73 | 154 |
| 180 | 155 Зкземпляр приложения содержит в себе глобальные настройки, реализует контроллер запросов, |
| 156 в качестве источника запросов используется CGI или иной совместимый модуль. | |
| 49 | 157 |
| 180 | 158 Процесс обработки запроса состоит из следующих частей |
| 49 | 159 |
| 67 | 160 =over |
| 161 | |
| 162 =item 1 | |
| 163 | |
| 180 | 164 Получение cgi запроса |
| 67 | 165 |
| 166 =item 2 | |
| 52 | 167 |
| 180 | 168 Создание объекта C<IMPL::Web::Application::Action> |
| 52 | 169 |
| 67 | 170 =item 3 |
| 52 | 171 |
| 180 | 172 Формирование цепочки вызовов при помощи C<< IMPL::Web::Application::Action->ChainHandler >> |
| 67 | 173 |
| 174 =item 4 | |
| 175 | |
| 180 | 176 Выполнение запроса C<< IMPL::Web::Application::Action->Invoke >> |
| 49 | 177 |
| 178 =cut | |
| 67 | 179 |
| 180 | 180 Также приложение поддерживает отложенное создание объектов, которые по первому обращению |
| 181 к свойствам. Это реализовано в базовом классе C< IMPL::Configuration >. Для настройки | |
| 182 активаторов можно использовать свойство C<options>, в которое должен быть помещен хеш | |
| 183 со ссылками на активаторы, см. пример ниже C<CONFIGURATION>. | |
| 67 | 184 |
| 185 =head2 CONFIGURATION | |
| 186 | |
| 180 | 187 Ниже приведен пример конфигурации приложения |
| 67 | 188 |
| 189 =begin code xml | |
| 190 | |
| 191 <?xml version="1.0" encoding="UTF-8"?> | |
| 192 <Application id='app' type="Test::Web::Application::Instance"> | |
| 193 | |
| 194 <!-- Begin custom properties --> | |
| 195 <name>Sample application</name> | |
| 196 <dataSource type='IMPL::Config::Activator' id='ds'> | |
| 197 <factory>IMPL::Object</factory> | |
| 198 <parameters type='HASH'> | |
| 199 <db>data</db> | |
| 200 <user>nobody</user> | |
| 201 </parameters> | |
| 202 </dataSource> | |
| 203 <securityMod type='IMPL::Config::Activator'> | |
| 204 <factory>IMPL::Object</factory> | |
| 205 <parameters type='HASH'> | |
| 206 <ds refid='ds'/> | |
| 207 </parameters> | |
| 208 </securityMod> | |
| 209 <!-- End custom properties --> | |
| 210 | |
| 211 <!-- direct access to the activators --> | |
| 212 <options type="HASH"> | |
| 213 <dataSource refid='ds'/> | |
| 214 </options> | |
| 215 | |
| 216 <!-- Set default output encoding, can be changed due query handling --> | |
| 217 <responseCharset>utf-8</responseCharset> | |
| 218 | |
| 219 <!-- Actions creation configuration --> | |
| 220 <actionFactory type="IMPL::Object::Factory"> | |
| 221 | |
| 222 <!-- Construct actions --> | |
| 223 <factory>IMPL::Web::Application::Action</factory> | |
| 224 <parameters type='HASH'> | |
| 225 | |
| 226 <!-- with special responseFactory --> | |
| 227 <responseFactory type='IMPL::Object::Factory'> | |
| 228 | |
| 229 <!-- Where resopnses have a special streamOut --> | |
| 230 <factory>IMPL::Web::Application::Response</factory> | |
| 231 <parameters type='HASH'> | |
| 232 | |
| 233 <!-- in memory dummy output instead of STDOUT --> | |
| 234 <streamOut>memory</streamOut> | |
| 235 | |
| 236 </parameters> | |
| 237 </responseFactory> | |
| 238 </parameters> | |
| 239 </actionFactory> | |
| 240 | |
| 241 <!-- Query processing chain --> | |
| 242 <handlersQuery type="IMPL::Object::List"> | |
| 243 <item type="IMPL::Web::QueryHandler::PageFormat"> | |
| 244 <templatesCharset>cp1251</templatesCharset> | |
| 245 </item> | |
| 246 </handlersQuery> | |
| 247 </Application> | |
| 248 | |
| 249 =end code xml | |
| 250 | |
| 73 | 251 =head1 MEMBERS |
| 252 | |
| 253 =over | |
| 254 | |
| 255 =item C<[get,set] handlerError> | |
| 256 | |
| 180 | 257 Обработчик который будет вызван в случае возникновения необработанной ошибки |
| 258 в процессе работы приложения. После чего приложение корректно завершается. | |
| 73 | 259 |
| 260 =item C<[get,set] actionFactory> | |
| 261 | |
| 180 | 262 Фабрика объектов, которая используется приложением, для создания объектов |
| 263 типа C<IMPL::Web::Application::Action> при обработки C<CGI> запросов. | |
| 73 | 264 |
| 265 =begin code | |
| 266 | |
| 267 my $action = $this->actionFactory->new( | |
| 268 query => $query, | |
| 269 application => $this, | |
| 270 ); | |
| 271 | |
| 272 =end code | |
| 273 | |
| 97 | 274 =item C< [get,set] fetchRequestMethod > |
| 275 | |
| 180 | 276 Метод получения CGI запроса. Возвращает C<CGI> объект следующего запроса, если |
| 277 запросов больше нет, то возвращает C<undef>. По-умолчанию использует C<defaultFetchRequest>. | |
| 97 | 278 |
| 180 | 279 Может быть как ссылкой на функцию, так и объектом типа C<IMPL::Web::Application::RequestFetcher>. |
| 97 | 280 |
| 73 | 281 =item C< [get,set,list] handlersQuery > |
| 282 | |
| 180 | 283 Список обработчиков запросов, которые будут переданы созданному объекту-действию. |
| 73 | 284 |
| 285 =item C< [get,set] responseCharset> | |
| 286 | |
| 180 | 287 Кодировка ответа клиенту. |
| 73 | 288 |
| 289 =item C< [get,set] security > | |
| 290 | |
| 180 | 291 Объект C<IMPL::Web::Security>, для работы с инфраструктурой безопасности. |
| 73 | 292 |
| 293 =item C< [get,set] options > | |
| 294 | |
| 180 | 295 Обычно ссылка на хеш с настраиваемыми объектами, используется для возможности |
| 296 програмной настройки активаторов, т.к. напрямую через свойства приложения получить | |
| 297 к ним доступ не получится. | |
| 73 | 298 |
| 299 =back | |
| 300 | |
| 180 | 301 =cut |