Mercurial > pub > Impl
annotate Lib/IMPL/Web/Application/Action.pm @ 222:84a6382b49c8
resources schema in progress
author | sergey |
---|---|
date | Mon, 27 Aug 2012 17:28:32 +0400 |
parents | c8fe3f84feba |
children | 47f77e6409f7 |
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; |
206 | 9 use Carp qw(carp); |
52 | 10 |
11 BEGIN { | |
194 | 12 public property application => prop_get | owner_set; |
13 public property query => prop_get | owner_set; | |
14 public property response => prop_get | owner_set; | |
15 public property responseFactory => prop_get | owner_set; | |
16 public property context => prop_get | owner_set; | |
17 private property _entryPoint => prop_all; | |
55 | 18 } |
19 | |
65 | 20 sub CTOR { |
194 | 21 my ($this) = @_; |
22 | |
23 $this->responseFactory('IMPL::Web::Application::Response') unless $this->responseFactory; | |
24 $this->response( $this->responseFactory->new(query => $this->query) ); | |
25 $this->context({}); | |
65 | 26 } |
63
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
62
diff
changeset
|
27 |
55 | 28 sub Invoke { |
194 | 29 my ($this) = @_; |
30 | |
31 if ($this->_entryPoint) { | |
32 $this->_entryPoint->(); | |
33 } else { | |
34 die new IMPL::InvalidOperationException("At least one handler is required"); | |
35 } | |
55 | 36 } |
37 | |
65 | 38 sub ReinitResponse { |
194 | 39 my ($this) = @_; |
40 | |
41 die new IMPL::InvalidOperationException("Response already sent") if $this->response->isHeaderPrinted; | |
42 | |
43 $this->response->Discard; | |
44 $this->response($this->responseFactory->new(query => $this->query)); | |
65 | 45 } |
46 | |
55 | 47 sub ChainHandler { |
194 | 48 my ($this,$handler) = @_; |
49 | |
206 | 50 carp "deprecated, use Application->handlers instead"; |
51 | |
194 | 52 my $delegateNext = $this->_entryPoint(); |
53 | |
54 if (ref $handler eq 'CODE') { | |
55 $this->_entryPoint( sub { | |
56 $handler->($this,$delegateNext); | |
57 } ); | |
58 } elsif (ref $handler and UNIVERSAL::isa($handler,'IMPL::Web::QueryHandler')) { | |
59 $this->_entryPoint( sub { | |
60 $handler->Invoke($this,$delegateNext); | |
61 } ); | |
62 } elsif ($handler and not ref $handler) { | |
63 | |
64 if (my $method = $this->can($handler) ) { | |
65 $this->_entryPoint( sub { | |
66 $method->($this,$delegateNext); | |
67 } ); | |
68 } else { | |
69 { | |
70 no strict 'refs'; | |
71 eval "require $handler; 1;" or die new IMPL::InvalidArgumentException("An invalid handler supplied",$handler,"Failed to load module") unless keys %{"${handler}::"}; | |
72 } | |
73 | |
74 if (UNIVERSAL::isa($handler,'IMPL::Web::QueryHandler')) { | |
75 $this->_entryPoint( sub { | |
76 $handler->Invoke($this,$delegateNext); | |
77 } ); | |
78 } else { | |
79 die new IMPL::InvalidArgumentException("An invalid handler supplied",$handler); | |
80 } | |
81 } | |
82 } else { | |
83 die new IMPL::InvalidArgumentException("An invalid handler supplied",$handler); | |
84 } | |
85 | |
52 | 86 } |
87 | |
144
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
88 sub cookie { |
194 | 89 my ($this,$name,$rx) = @_; |
90 | |
91 $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
|
92 } |
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
93 |
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
94 sub param { |
194 | 95 my ($this,$name,$rx) = @_; |
96 | |
97 $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
|
98 } |
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 sub _launder { |
194 | 101 my ($this,$value,$rx) = @_; |
102 | |
103 if ( $value ) { | |
104 if ($rx) { | |
105 if ( my @result = ($value =~ m/$rx/) ) { | |
106 return @result > 1 ? \@result : $result[0]; | |
107 } else { | |
108 return undef; | |
109 } | |
110 } else { | |
111 return $value; | |
112 } | |
113 } else { | |
114 return undef; | |
115 } | |
144
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
116 } |
b56ebc31bf18
Empty nodes no more created while transforming a post request to the DOM document
wizard
parents:
67
diff
changeset
|
117 |
52 | 118 1; |
119 | |
120 __END__ | |
121 | |
122 =pod | |
123 | |
67 | 124 =head1 NAME |
125 | |
180 | 126 C<IMPL::Web::Application::Action> - Обертка вокруг C<CGI> запроса. |
67 | 127 |
52 | 128 =head1 DESCRIPTION |
129 | |
67 | 130 C<[Infrastructure]> |
206 | 131 Свзяывет CGI запрос, приложение, орабатывающее его и ответ, который будет отправлен клиенту. |
52 | 132 |
67 | 133 =head1 MEMBERS |
134 | |
135 =head2 PROPERTIES | |
136 | |
137 =over | |
138 | |
139 =item C< [get] application> | |
140 | |
180 | 141 Экземпляр приложения создавшего текущий объект |
67 | 142 |
143 =item C< [get] query > | |
144 | |
180 | 145 Экземпляр C<CGI> запроса |
67 | 146 |
147 =item C< [get] response > | |
148 | |
180 | 149 Ответ на C<CGI> заспрос C<IMPL::Web::Application::Response> |
67 | 150 |
151 =item C< [get] responseFactory > | |
152 | |
180 | 153 Фабрика ответов на запрос, используется для создания нового ответа |
154 либо при конструировании текущего объекта C<IMPL::Web::Application::Action>, | |
155 либо при вызове метода C<ReinitResponse> у текущего объекта. | |
67 | 156 |
180 | 157 По умолчанию имеет значение C<IMPL::Web::Application::Response> |
67 | 158 |
159 =back | |
160 | |
161 =head2 METHODS | |
162 | |
163 =over | |
164 | |
165 =item C< ReinitResponse() > | |
166 | |
180 | 167 Отмена старого ответа C<response> и создание вместо него нового. |
67 | 168 |
180 | 169 Данная операция обычно проводится при обработке ошибок, когда |
170 уже сформированный ответ требуется отменить. Следует заметить, | |
171 что эта операция не возможна, если ответ частично или полностью | |
172 отправлен клиенту. Тогда возникает исключение C<IMPL::InvalidOperationException>. | |
67 | 173 |
180 | 174 =cut |