Mercurial > pub > Impl
annotate Lib/IMPL/Web/Application/Action.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 |
|---|---|
| 52 | 1 package IMPL::Web::Application::Action; |
| 55 | 2 use strict; |
| 52 | 3 |
| 166 | 4 use parent qw(IMPL::Object IMPL::Object::Autofill); |
| 52 | 5 |
|
63
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
62
diff
changeset
|
6 __PACKAGE__->PassThroughArgs; |
|
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
62
diff
changeset
|
7 |
| 52 | 8 use IMPL::Class::Property; |
| 9 | |
| 10 BEGIN { | |
| 11 public property application => prop_get | owner_set; | |
| 62 | 12 public property query => prop_get | owner_set; |
| 52 | 13 public property response => prop_get | owner_set; |
| 65 | 14 public property responseFactory => prop_get | owner_set; |
| 173 | 15 public property context => prop_get | owner_set; |
| 55 | 16 private property _entryPoint => prop_all; |
| 17 } | |
| 18 | |
| 65 | 19 sub CTOR { |
| 20 my ($this) = @_; | |
| 21 | |
| 22 $this->responseFactory('IMPL::Web::Application::Response') unless $this->responseFactory; | |
| 23 $this->response( $this->responseFactory->new(query => $this->query) ); | |
| 173 | 24 $this->context({}); |
| 65 | 25 } |
|
63
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
62
diff
changeset
|
26 |
| 55 | 27 sub Invoke { |
| 28 my ($this) = @_; | |
| 29 | |
| 30 if ($this->_entryPoint) { | |
| 31 $this->_entryPoint->(); | |
| 32 } else { | |
| 33 die new IMPL::InvalidOperationException("At least one handler is required"); | |
| 34 } | |
| 35 } | |
| 36 | |
| 65 | 37 sub ReinitResponse { |
| 38 my ($this) = @_; | |
| 39 | |
| 40 die new IMPL::InvalidOperationException("Response already sent") if $this->response->isHeaderPrinted; | |
| 41 | |
| 42 $this->response->Discard; | |
| 43 $this->response($this->responseFactory->new(query => $this->query)); | |
| 44 } | |
| 45 | |
| 55 | 46 sub ChainHandler { |
| 47 my ($this,$handler) = @_; | |
| 48 | |
| 49 my $delegateNext = $this->_entryPoint(); | |
| 50 | |
| 51 if (ref $handler eq 'CODE') { | |
| 56 | 52 $this->_entryPoint( sub { |
| 173 | 53 $handler->($this,$delegateNext); |
| 56 | 54 } ); |
|
63
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
62
diff
changeset
|
55 } elsif (ref $handler and UNIVERSAL::isa($handler,'IMPL::Web::QueryHandler')) { |
| 56 | 56 $this->_entryPoint( sub { |
| 55 | 57 $handler->Invoke($this,$delegateNext); |
| 56 | 58 } ); |
| 59 } elsif ($handler and not ref $handler) { | |
| 60 | |
|
63
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
62
diff
changeset
|
61 if (my $method = $this->can($handler) ) { |
|
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
62
diff
changeset
|
62 $this->_entryPoint( sub { |
|
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
62
diff
changeset
|
63 $method->($this,$delegateNext); |
|
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
62
diff
changeset
|
64 } ); |
|
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
62
diff
changeset
|
65 } else { |
|
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
62
diff
changeset
|
66 { |
|
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
62
diff
changeset
|
67 no strict 'refs'; |
|
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
62
diff
changeset
|
68 eval "require $handler; 1;" or die new IMPL::InvalidArgumentException("An invalid handler supplied",$handler,"Failed to load module") unless keys %{"${handler}::"}; |
|
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
62
diff
changeset
|
69 } |
|
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
62
diff
changeset
|
70 |
|
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
62
diff
changeset
|
71 if (UNIVERSAL::isa($handler,'IMPL::Web::QueryHandler')) { |
|
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
62
diff
changeset
|
72 $this->_entryPoint( sub { |
|
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
62
diff
changeset
|
73 $handler->Invoke($this,$delegateNext); |
|
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
62
diff
changeset
|
74 } ); |
|
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
62
diff
changeset
|
75 } else { |
|
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
62
diff
changeset
|
76 die new IMPL::InvalidArgumentException("An invalid handler supplied",$handler); |
|
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
62
diff
changeset
|
77 } |
|
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
62
diff
changeset
|
78 } |
| 55 | 79 } else { |
|
63
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
62
diff
changeset
|
80 die new IMPL::InvalidArgumentException("An invalid handler supplied",$handler); |
| 55 | 81 } |
| 82 | |
| 52 | 83 } |
| 84 | |
|
144
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
85 sub cookie { |
|
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
86 my ($this,$name,$rx) = @_; |
|
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
87 |
| 149 | 88 $this->_launder(scalar( $this->query->cookie($name) ), $rx ); |
|
144
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
89 } |
|
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
90 |
|
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
91 sub param { |
|
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
92 my ($this,$name,$rx) = @_; |
|
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
93 |
| 146 | 94 $this->_launder(scalar( $this->query->param($name) ), $rx ); |
|
144
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
95 } |
|
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
96 |
|
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
97 sub _launder { |
|
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
98 my ($this,$value,$rx) = @_; |
|
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
99 |
|
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
100 if ( $value ) { |
|
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
101 if ($rx) { |
|
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
102 if ( my @result = ($value =~ m/$rx/) ) { |
| 149 | 103 return @result > 1 ? \@result : $result[0]; |
|
144
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
104 } else { |
|
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
105 return undef; |
|
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
106 } |
|
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
107 } else { |
|
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
108 return $value; |
|
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
109 } |
|
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
110 } else { |
|
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
111 return undef; |
|
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
112 } |
|
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
113 } |
|
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
114 |
| 52 | 115 1; |
| 116 | |
| 117 __END__ | |
| 118 | |
| 119 =pod | |
| 120 | |
| 67 | 121 =head1 NAME |
| 122 | |
| 180 | 123 C<IMPL::Web::Application::Action> - Обертка вокруг C<CGI> запроса. |
| 67 | 124 |
| 52 | 125 =head1 DESCRIPTION |
| 126 | |
| 67 | 127 C<[Infrastructure]> |
| 52 | 128 |
| 180 | 129 Определяет порядок выполнения запроса. Запрос выполняется последовательным вызовом |
| 130 цепочки обработчиков, при этом обработчики сами вызывают следующие. | |
| 131 Обработчики выполняются в порядке, обратном их добавлению. | |
| 52 | 132 |
| 180 | 133 Типичная цепочка может быть такой, в порядке добавления |
| 52 | 134 |
| 67 | 135 =begin code |
| 136 | |
| 137 IMPL::Web::QueryHandler::SecCallToMethod | |
| 138 IMPL::Web::QueryHandler::AuthenticateCookie | |
| 139 IMPL::Web::QueryHandler::PageFormat | |
| 140 | |
| 141 =end code | |
| 52 | 142 |
| 180 | 143 что приведет к следующей последовательности |
| 52 | 144 |
| 67 | 145 =begin code |
| 146 | |
| 147 # the application creates a new Action object | |
| 148 | |
| 149 my $action = $application->actionFactory->new( | |
| 150 action => $application, # the application passes self | |
| 151 query => $query # current CGI query | |
| 152 ); | |
| 153 | |
| 154 # forms query handlers stack | |
| 155 | |
| 156 $action->ChainHandler($_) foreach qw ( | |
| 157 IMPL::Web::QueryHandler::SecCallToMethod | |
| 158 IMPL::Web::QueryHandler::AuthenticateCookie | |
| 159 IMPL::Web::QueryHandler::PageFormat | |
| 160 ); | |
| 161 | |
| 162 # and finally invokes the action | |
| 163 | |
| 164 $action->Invoke() { | |
| 165 | |
| 166 # some internals | |
| 167 | |
| 168 IMPL::Web::QueryHandler::PageFormat->Invoke($action,$nextHandlerIsAuthHandler) { | |
| 169 | |
| 170 #some internals | |
| 171 | |
| 172 my $result = $nextHandlerIsAuthHandler() { | |
| 173 | |
| 174 # some internals | |
| 175 | |
| 176 IMPL::Web::QueryHandler::AuthenticateCookie->Invoke($action,$nextHandlerIsSecCall) { | |
| 177 | |
| 178 # some internals | |
| 179 # do auth and generate security $context | |
| 180 | |
| 181 # impersonate $context and call the next handler | |
| 182 return $context->Impersonate($nextHandlerIsSecCall) { | |
| 183 | |
| 184 # some internals | |
| 185 | |
| 186 IMPL::Web::QueryHandler::SecCallToMethod->Invoke($action,undef) { | |
| 187 | |
| 188 # next handler isn't present as it is the last hanler | |
| 189 | |
| 190 # some internals | |
| 191 # calculate the $method and the $target from CGI request | |
| 192 | |
| 52 | 193 IMPL::Security->AccessCheck($target,$method); |
| 194 return $target->$method(); | |
| 67 | 195 |
| 52 | 196 } |
| 67 | 197 |
| 52 | 198 } |
| 67 | 199 |
| 52 | 200 } |
| 201 } | |
| 67 | 202 |
| 203 # some intenals | |
| 204 # formatted output to $action->response->streamBody | |
| 52 | 205 } |
| 206 } | |
| 207 | |
| 67 | 208 =end code |
| 209 | |
| 180 | 210 или как альтернатива может быть еще |
| 52 | 211 |
| 67 | 212 =begin code |
| 213 | |
| 214 IMPL::Web::QueryHandler::SecCallToMethod | |
| 215 IMPL::Web::QueryHandler::AuthenticateCookie | |
| 216 IMPL::Web::QueryHandler::Filter->new( target => IMPL::Transform::ObjectToJSON->new() , method => 'Transform') | |
| 217 IMLP::Web::QueryHandler::JSONFormat | |
| 218 | |
| 219 | |
| 220 =end code | |
| 52 | 221 |
| 180 | 222 В данной цепочке также происходит вызов метода, но его результат потом преобразуется |
| 223 в простые структуры и передается JSON преобразователю. Таким образом модулю логики | |
| 224 не требуется знать о выходном формате, всю работу проделают дополнительные фильтры. | |
| 52 | 225 |
| 67 | 226 =head1 MEMBERS |
| 227 | |
| 228 =head2 PROPERTIES | |
| 229 | |
| 230 =over | |
| 231 | |
| 232 =item C< [get] application> | |
| 233 | |
| 180 | 234 Экземпляр приложения создавшего текущий объект |
| 67 | 235 |
| 236 =item C< [get] query > | |
| 237 | |
| 180 | 238 Экземпляр C<CGI> запроса |
| 67 | 239 |
| 240 =item C< [get] response > | |
| 241 | |
| 180 | 242 Ответ на C<CGI> заспрос C<IMPL::Web::Application::Response> |
| 67 | 243 |
| 244 =item C< [get] responseFactory > | |
| 245 | |
| 180 | 246 Фабрика ответов на запрос, используется для создания нового ответа |
| 247 либо при конструировании текущего объекта C<IMPL::Web::Application::Action>, | |
| 248 либо при вызове метода C<ReinitResponse> у текущего объекта. | |
| 67 | 249 |
| 180 | 250 По умолчанию имеет значение C<IMPL::Web::Application::Response> |
| 67 | 251 |
| 252 =back | |
| 253 | |
| 254 =head2 METHODS | |
| 255 | |
| 256 =over | |
| 257 | |
| 258 =item C< ReinitResponse() > | |
| 259 | |
| 180 | 260 Отмена старого ответа C<response> и создание вместо него нового. |
| 67 | 261 |
| 180 | 262 Данная операция обычно проводится при обработке ошибок, когда |
| 263 уже сформированный ответ требуется отменить. Следует заметить, | |
| 264 что эта операция не возможна, если ответ частично или полностью | |
| 265 отправлен клиенту. Тогда возникает исключение C<IMPL::InvalidOperationException>. | |
| 67 | 266 |
| 267 =item C< ChainHandler($handler) > | |
| 268 | |
| 180 | 269 Добавляет новый обработчик в цепочку. Выполнение цепочки начинается с конца, |
| 270 тоесть последний добавленный будет выполнен первым. | |
| 67 | 271 |
| 272 =back | |
| 273 | |
| 56 | 274 =head1 HANDLERS |
| 275 | |
| 276 =head2 subroutines | |
| 277 | |
| 278 =over | |
| 279 | |
| 280 =item CODE ref | |
| 281 | |
| 180 | 282 Ссылка на процедуру может являться обработчиком, при этом функция будет вызвана с |
| 283 двумя параметрами: ссылкой на action объект, и точкой входа следующего обработчика. | |
| 56 | 284 |
| 285 =item Method Name | |
| 286 | |
| 180 | 287 Имя метода, передается в виде строки. У текущего объекта action ищется метод с |
| 288 указанным именем, после чего используется ссылка на этот метод для вызова с двумя | |
| 289 параметрами: ссылкой на action объект, и точкой входа следующего обработчика. | |
| 56 | 290 |
| 180 | 291 Получается вызов идентичный следующему C<< $action->MethodName($nextHandler) >>; |
| 56 | 292 |
| 293 =back | |
| 294 | |
| 67 | 295 =head2 C< IMPL::Web::QueryHandler > |
| 57 | 296 |
| 180 | 297 Любой объект наследованный от C< IMPL::Web::QueryHandler > может быть |
| 298 использован в качестве обработчика запроса | |
| 57 | 299 |
| 180 | 300 =cut |