Mercurial > pub > Impl
annotate Lib/IMPL/Web/Application/ControllerUnit.pm @ 245:7c517134c42f
Added Unsupported media type Web exception
corrected resourceLocation setting in the resource
Implemented localizable resources for text messages
fixed TT view scopings, INIT block in controls now sets globals correctly.
| author | sergey |
|---|---|
| date | Mon, 29 Oct 2012 03:15:22 +0400 |
| parents | 4d0e1962161c |
| children | c6d0f889ef87 |
| rev | line source |
|---|---|
| 133 | 1 use strict; |
| 110 | 2 package IMPL::Web::Application::ControllerUnit; |
| 166 | 3 use parent qw(IMPL::Object); |
| 110 | 4 |
| 5 use IMPL::Class::Property; | |
| 112 | 6 use IMPL::DOM::Transform::PostToDOM; |
| 7 use IMPL::DOM::Schema; | |
| 113 | 8 use Class::Inspector; |
| 9 use File::Spec; | |
| 133 | 10 use Sub::Name; |
| 112 | 11 |
| 12 use constant { | |
| 194 | 13 CONTROLLER_METHODS => 'controller_methods', |
| 14 STATE_CORRECT => 'correct', | |
| 15 STATE_NEW => 'new', | |
| 16 STATE_INVALID => 'invalid', | |
| 17 TTYPE_FORM => 'form', | |
| 18 TTYPE_TRANS => 'tran' | |
| 112 | 19 }; |
| 110 | 20 |
| 21 BEGIN { | |
| 194 | 22 public property action => prop_get | owner_set; |
| 23 public property application => prop_get | owner_set; | |
| 24 public property query => prop_get | owner_set; | |
| 25 public property response => prop_get | owner_set; | |
| 26 public property formData => prop_get | owner_set; | |
| 27 public property formSchema => prop_get | owner_set; | |
| 28 public property formErrors => prop_get | owner_set; | |
| 110 | 29 } |
| 30 | |
| 170 | 31 my %publicProps = map {$_->Name , 1} __PACKAGE__->get_meta(typeof IMPL::Class::PropertyInfo); |
| 133 | 32 |
| 113 | 33 __PACKAGE__->class_data(CONTROLLER_METHODS,{}); |
| 34 | |
| 170 | 35 our @schemaInc; |
| 36 | |
| 110 | 37 sub CTOR { |
| 194 | 38 my ($this,$action,$args) = @_; |
| 39 | |
| 40 $this->action($action); | |
| 41 $this->application($action->application); | |
| 42 $this->query($action->query); | |
| 43 $this->response($action->response); | |
| 44 | |
| 45 $this->$_($args->{$_}) foreach qw(formData formSchema formErrors); | |
| 112 | 46 } |
| 47 | |
| 134 | 48 sub unitNamespace() { |
| 194 | 49 "" |
| 134 | 50 } |
| 51 | |
| 52 sub transactions { | |
| 194 | 53 my ($self,%methods) = @_; |
| 54 | |
| 55 while (my ($method,$info) = each %methods) { | |
| 56 if ($info and ref $info ne 'HASH') { | |
| 57 warn "Bad transaction $method description"; | |
| 58 $info = {}; | |
| 59 } | |
| 60 | |
| 61 $info->{wrapper} = 'TransactionWrapper'; | |
| 62 $info->{method} ||= $method; | |
| 63 $info->{context}{transactionType} = TTYPE_TRANS; | |
| 64 $self->class_data(CONTROLLER_METHODS)->{$method} = $info; | |
| 65 } | |
| 134 | 66 } |
| 67 | |
| 112 | 68 sub forms { |
| 194 | 69 my ($self,%forms) = @_; |
| 70 | |
| 71 while ( my ($method,$info) = each %forms ) { | |
| 72 die new IMPL::Exception("A method doesn't exists in the controller",$self,$method) unless $self->can($method); | |
| 73 if ( not ref $info ) { | |
| 74 $self->class_data(CONTROLLER_METHODS)->{$method} = { | |
| 75 wrapper => 'FormWrapper', | |
| 76 schema => $info, | |
| 77 method => $method, | |
| 78 context => { transactionType => TTYPE_FORM } | |
| 79 }; | |
| 80 } elsif (ref $info eq 'HASH') { | |
| 81 $info->{wrapper} = 'FormWrapper'; | |
| 82 $info->{method} ||= $method; | |
| 83 $info->{context}{transactionType} = TTYPE_FORM; | |
| 84 | |
| 85 $self->class_data(CONTROLLER_METHODS)->{$method} = $info; | |
| 86 } else { | |
| 87 die new IMPL::Exception("Unsupported method information",$self,$method); | |
| 88 } | |
| 89 } | |
| 112 | 90 } |
| 91 | |
| 110 | 92 sub InvokeAction { |
| 194 | 93 my ($self,$method,$action) = @_; |
| 94 | |
| 95 if (my $methodInfo = $self->class_data(CONTROLLER_METHODS)->{$method}) { | |
| 96 if (my $ctx = $methodInfo->{context}) { | |
| 97 $action->context->{$_} = $ctx->{$_} foreach keys %$ctx; | |
| 98 } | |
| 99 if (my $wrapper = $methodInfo->{wrapper}) { | |
| 100 return $self->$wrapper($method,$action,$methodInfo); | |
| 101 } else { | |
| 102 return $self->TransactionWrapper($method,$action,$methodInfo); | |
| 103 } | |
| 104 } else { | |
| 105 die new IMPL::InvalidOperationException("Invalid method call",$self,$method); | |
| 106 } | |
| 111 | 107 } |
| 108 | |
| 133 | 109 sub MakeParams { |
| 194 | 110 my ($this,$methodInfo) = @_; |
| 111 | |
| 112 my $params; | |
| 113 if ($params = $methodInfo->{parameters} and ref $params eq 'ARRAY') { | |
| 114 return map $this->ResolveParam($_,$methodInfo->{inflate}{$_}), @$params; | |
| 115 } | |
| 116 return(); | |
| 133 | 117 } |
| 118 | |
| 119 sub ResolveParam { | |
| 194 | 120 my ($this,$param,$inflate) = @_; |
| 121 | |
| 122 if ( $param =~ /^::(\w+)$/ and $publicProps{$1}) { | |
| 123 return $this->$1(); | |
| 124 } else { | |
| 125 my $value; | |
| 126 if ( my $rx = $inflate->{rx} ) { | |
| 127 $value = $this->action->param($param,$rx); | |
| 128 } else { | |
| 129 $value = $this->query->param($param); | |
| 130 } | |
| 131 | |
| 132 if (my $method = $inflate->{method}) { | |
| 133 $value = $this->$method($value); | |
| 134 } | |
| 135 return $value; | |
| 136 } | |
| 133 | 137 } |
| 138 | |
| 112 | 139 sub TransactionWrapper { |
| 194 | 140 my ($self,$method,$action,$methodInfo) = @_; |
| 141 | |
| 142 my $unit = $self->new($action); | |
| 143 my $handler = $methodInfo->{method}; | |
| 144 return $unit->$handler($unit->MakeParams($methodInfo)); | |
| 112 | 145 } |
| 146 | |
| 147 sub FormWrapper { | |
| 194 | 148 my ($self,$method,$action,$methodInfo) = @_; |
| 149 | |
| 150 my $schema = $methodInfo->{schema} ? $self->loadSchema($methodInfo->{schema}) : $self->unitSchema; | |
| 151 | |
| 152 my $process = $action->query->param('process') || 0; | |
| 153 my $form = $methodInfo->{form} | |
| 154 || $action->query->param('form') | |
| 155 || $method; | |
| 156 | |
| 157 my %result; | |
| 158 | |
| 159 my $transform = IMPL::DOM::Transform::PostToDOM->new( | |
| 160 undef, | |
| 161 $schema, | |
| 162 $form | |
| 163 ); | |
| 164 | |
| 165 my $handler = $methodInfo->{method}; | |
| 166 | |
| 167 $result{formName} = $form; | |
| 168 $result{formSchema} = $schema; | |
| 169 | |
| 170 if ($process) { | |
| 171 $result{formData} = $transform->Transform($action->query); | |
| 172 $result{formErrors} = $transform->Errors->as_list; | |
| 173 if ($transform->Errors->Count) { | |
| 174 $result{state} = STATE_INVALID; | |
| 175 } else { | |
| 176 $result{state} = STATE_CORRECT; | |
| 177 my $unit = $self->new($action,\%result); | |
| 178 | |
| 179 eval { | |
| 180 $result{result} = $unit->$handler($unit->MakeParams($methodInfo)); | |
| 181 }; | |
| 182 if (my $err = $@) { | |
| 183 $result{state} = STATE_INVALID; | |
| 184 if (eval { $err->isa(typeof IMPL::WrongDataException) } ) { | |
| 185 $result{formErrors} = $err->Args; | |
| 186 } else { | |
| 187 die $err; | |
| 188 } | |
| 189 } | |
| 190 } | |
| 191 } else { | |
| 192 if (my $initMethod = $methodInfo->{init}) { | |
| 193 my $unit = $self->new($action,\%result); | |
| 194 $result{formData} = $transform->Transform( $unit->$initMethod($unit->MakeParams($methodInfo)) ); | |
| 195 } else { | |
| 196 $result{formData} = $transform->Transform($action->query); | |
| 197 } | |
| 198 | |
| 199 # ignore errors for new forms | |
| 200 #$result{formErrors} = $transform->Errors->as_list; | |
| 201 $result{state} = STATE_NEW; | |
| 202 } | |
| 203 | |
| 204 return \%result; | |
| 113 | 205 } |
| 206 | |
| 207 sub loadSchema { | |
| 194 | 208 my ($self,$name) = @_; |
| 209 | |
| 210 foreach my $path (map File::Spec->catfile($_,$name) ,@schemaInc) { | |
| 211 return IMPL::DOM::Schema->LoadSchema($path) if -f $path; | |
| 212 } | |
| 113 | 213 |
| 194 | 214 die new IMPL::Exception("A schema isn't found", $name); |
| 170 | 215 } |
| 216 | |
| 217 sub unitSchema { | |
| 194 | 218 my ($self) = @_; |
| 219 | |
| 220 my $class = ref $self || $self; | |
| 221 | |
| 222 my @parts = split(/:+/, $class); | |
| 223 | |
| 224 my $file = pop @parts; | |
| 225 $file = "${file}.schema.xml"; | |
| 226 | |
| 227 foreach my $inc ( @schemaInc ) { | |
| 228 my $path = File::Spec->catfile($inc,@parts,$file); | |
| 229 | |
| 230 return IMPL::DOM::Schema->LoadSchema($path) if -f $path; | |
| 231 } | |
| 232 | |
| 233 return undef; | |
| 112 | 234 } |
| 235 | |
| 134 | 236 sub discover { |
| 194 | 237 my ($this) = @_; |
| 238 | |
| 239 my $methods = $this->class_data(CONTROLLER_METHODS); | |
| 240 | |
| 241 my $namespace = $this->unitNamespace; | |
| 242 (my $module = typeof $this) =~ s/^$namespace//; | |
| 243 | |
| 244 my %smd = ( | |
| 245 module => [grep $_, split /::/, $module ], | |
| 246 ); | |
| 247 | |
| 248 while (my ($method,$info) = each %$methods) { | |
| 249 my %methodInfo = ( | |
| 250 name => $method | |
| 251 ); | |
| 252 $methodInfo{parameters} = [ grep /^[^\:]/, @{ $info->{parameters} } ] if ref $info->{parameters} eq 'ARRAY'; | |
| 253 push @{$smd{methods}},\%methodInfo; | |
| 254 } | |
| 255 return \%smd; | |
| 133 | 256 } |
| 257 | |
| 134 | 258 __PACKAGE__->transactions( |
| 194 | 259 discover => undef |
| 134 | 260 ); |
| 133 | 261 |
| 111 | 262 1; |
| 263 | |
| 264 __END__ | |
| 265 | |
| 266 =pod | |
| 267 | |
| 268 =head1 NAME | |
| 269 | |
| 180 | 270 C<IMPL::Web::Application::ControllerUnit> - базовый класс для обработчика транзакций в модели контроллера. |
| 111 | 271 |
| 272 =head1 DESCRIPTION | |
| 273 | |
| 180 | 274 Классы, наследуемые от данного класса называется пакетом транзакций. Часть методов в таком классе |
| 275 объявляются как транзакции при помощи методов C<transaction>, C<form>. | |
| 111 | 276 |
| 180 | 277 Перед выполнением транзакции создается экземпляр объекта, в рамках которого будет выполнена транзакция. |
| 278 Для этого вызывается метод C<InvokeAction($method,$action)>, который создает/восстанавливает контекст | |
| 279 транзакции. | |
| 111 | 280 |
| 180 | 281 Транзакции на данный момент делятся на простые и формы. Различные типы транзакций выполняются при помощи |
| 282 различных оберток (C<TransactionWrapper> и C<FormWrapper>). Каждая обертка отвечает за конструирование | |
| 283 экземпляра объекта и вызов метода для выполнения транзакции, а также за возврат результата выполнения. | |
| 111 | 284 |
| 180 | 285 =head2 Простые транзакции |
| 111 | 286 |
| 180 | 287 Простые транзакции получаю только запрос, без предварительной обработки, и возвращенный результат напрямую |
| 288 передается пользователю. | |
| 111 | 289 |
| 180 | 290 =head2 Формы |
| 111 | 291 |
| 180 | 292 При использовании форм запрос предварительно обрабатывается, для получения DOM документа с данными формы. |
| 293 Для постороенния DOM документа используется схема. При этом становятся доступны дополнительные свойства | |
| 111 | 294 C<formData>, C<formSchema>, C<formErrors>. |
| 295 | |
| 180 | 296 Результат выполнения транзакции не возвращается наверх напрямую, а включается в структуру, которая |
| 297 выглядит следующим образом | |
| 111 | 298 |
| 299 =begin code | |
| 300 | |
| 301 { | |
| 194 | 302 state => '{ new | correct | invalid }', |
| 303 result => $transactionResult, | |
| 304 formData => $formDOM, | |
| 305 formSchema => $formSchema, | |
| 306 formErrors => @errors | |
| 111 | 307 } |
| 308 | |
| 309 =end code | |
| 310 | |
| 311 =over | |
| 312 | |
| 313 =item C<state> | |
| 314 | |
| 180 | 315 Состояние верификации формы. |
| 111 | 316 |
| 317 =over | |
| 318 | |
| 319 =item C<new> | |
| 320 | |
| 180 | 321 Первоначальное содержимое формы, оно может быть некорректным, но это нормально. |
| 322 В данном состоянии транзакция обычно не выполняется. | |
| 111 | 323 |
| 324 =item C<correct> | |
| 325 | |
| 180 | 326 Данные формы корректны, транзакция выполнена, и ее результат доступен через поле C<result> |
| 111 | 327 |
| 328 =item C<invalid> | |
| 329 | |
| 180 | 330 Содержимое формы не прошло верификацию, ошибки доступны через поле C<formErrors>. Транзакция |
| 331 не выполнялась. | |
| 111 | 332 |
| 333 =back | |
| 334 | |
| 335 =item C<result> | |
| 336 | |
| 180 | 337 Результат выполнения транзакции, если конечно таковая выполнялась. |
| 111 | 338 |
| 339 =item C<formData> | |
| 340 | |
| 180 | 341 ДОМ документ с данными формами. Документ существует всегда, не зависимо от его корректности, |
| 342 может быть использован для построения формы, уже заполненную параметрами. | |
| 111 | 343 |
| 344 =item C<formSchema> | |
| 345 | |
| 180 | 346 Схема данных формы, может использоваться для построения динамических форм. |
| 111 | 347 |
| 348 =item C<formErrors> | |
| 349 | |
| 180 | 350 Ссылка на массив с ошибками при проверки формы. |
| 111 | 351 |
| 352 =back | |
| 353 | |
| 354 =head1 MEMBERS | |
| 355 | |
| 356 =over | |
| 357 | |
| 358 =item C<[get] application> | |
| 359 | |
| 180 | 360 Объект приложения, которое обрабатывает запрос. |
|
128
08753833173d
Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents:
127
diff
changeset
|
361 |
| 111 | 362 =item C<[get] query> |
| 363 | |
| 180 | 364 Текущий запрос. |
|
128
08753833173d
Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents:
127
diff
changeset
|
365 |
| 111 | 366 =item C<[get] response> |
| 367 | |
| 180 | 368 Текущий ответ. |
|
128
08753833173d
Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents:
127
diff
changeset
|
369 |
| 111 | 370 =item C<[get] formData> |
| 371 | |
| 180 | 372 C<IMPL::DOM::Document> документ с данныим, если данный запрос является формой. |
|
128
08753833173d
Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents:
127
diff
changeset
|
373 |
| 111 | 374 =item C<[get] formSchema> |
| 375 | |
| 180 | 376 C<IMPL::DOM::Schema> документ со схемой формы данного запроса. |
|
128
08753833173d
Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents:
127
diff
changeset
|
377 |
| 111 | 378 =item C<[get] formErrors> |
| 379 | |
| 180 | 380 Ошибки верификации данных, если таковые были. Обычно при наличии ошибок в форме, транзакция |
| 381 не выполняется, а эти ошибки передаются в ответ. | |
|
128
08753833173d
Fixed a error handling issue in JSON output: errors are correctly transfered
wizard
parents:
127
diff
changeset
|
382 |
| 111 | 383 =item C<InvokeAction($method,$action)> |
| 384 | |
| 180 | 385 Конструирует контекст выполнения транзакции, может быть переопределен для конструирования контекста по |
| 386 своим правилам. | |
| 112 | 387 |
| 388 =item C<TransactionWrapper($method,$action,$methodInfo)> | |
| 389 | |
| 180 | 390 Обертка для конструирования простых транзакций, может быть переопределен для конструирования контекста по |
| 391 своим правилам. | |
| 112 | 392 |
| 393 =item C<FormWrapper($method,$action,$methodInfo)> | |
| 394 | |
| 180 | 395 Обертка для конструирования форм, может быть переопределен для конструирования контекста по |
| 396 своим правилам. | |
| 111 | 397 |
| 134 | 398 =item C<discover()> |
| 399 | |
| 180 | 400 Метод, опубликованный для вызова контроллером, возвращает описание методов в формате C<Simple Module Definition>. |
| 134 | 401 |
| 402 =begin code | |
| 403 | |
| 404 # SMD structure | |
| 405 { | |
| 194 | 406 module => ['Foo','Bar'], |
| 407 methods => [ | |
| 408 { | |
| 409 name => 'search', | |
| 410 parameters => ['text','limit'] #optional | |
| 411 } | |
| 412 ] | |
| 134 | 413 } |
| 414 | |
| 415 =end code | |
| 416 | |
| 111 | 417 =back |
| 418 | |
| 419 =head1 EXAMPLE | |
| 420 | |
| 421 =begin code | |
| 422 | |
| 423 package MyBooksUnit; | |
| 424 use strict; | |
| 166 | 425 use parent qw(IMPL::Web::Application::ControllerUnit); |
| 111 | 426 |
| 427 __PACKAGE__->PassThroughArgs; | |
| 428 | |
| 134 | 429 sub unitDataClass { 'My::Books' } |
| 430 | |
| 431 __PACKAGE__->transactions( | |
| 194 | 432 find => { |
| 433 parameters => [qw(author)] | |
| 434 }, | |
| 435 info => { | |
| 436 parameters => [qw(id)] | |
| 437 } | |
| 134 | 438 ); |
| 111 | 439 __PACKAGE__->forms( |
| 194 | 440 create => 'books.create.xml' |
| 111 | 441 ); |
| 442 | |
| 443 sub find { | |
| 194 | 444 my ($this,$author) = @_; |
| 445 | |
| 446 return $this->ds->find({author => $author}); | |
| 111 | 447 } |
| 448 | |
| 449 sub info { | |
| 194 | 450 my ($this,$id) = @_; |
| 451 | |
| 452 return $this->ds->find({id => $id}); | |
| 111 | 453 } |
| 454 | |
| 455 sub create { | |
| 194 | 456 my ($this) = @_; |
| 457 | |
| 458 my %book = map { | |
| 459 $_->nodeName, $_->nodeValue | |
| 460 } $this->formData->selectNodes([qw(author_id title year ISBN)]); | |
| 461 | |
| 462 return $this->ds->create(\%book); | |
| 111 | 463 } |
| 464 | |
| 465 =end code | |
| 466 | |
| 180 | 467 =cut |