Mercurial > pub > Impl
annotate Lib/IMPL/Web/Application/Response.pm @ 74:84aa8c395fce
doc
minor fixes
author | wizard |
---|---|
date | Mon, 29 Mar 2010 17:40:06 +0400 |
parents | 9f5795a10939 |
children | 67eb8eaec3d4 |
rev | line source |
---|---|
59
0f3e369553bd
Rewritten property implementation (probably become slower but more flexible)
wizard
parents:
58
diff
changeset
|
1 package IMPL::Web::Application::Response; |
57 | 2 use strict; |
3 | |
4 use base qw(IMPL::Object IMPL::Object::Autofill); | |
5 | |
6 require IMPL::Exception; | |
7 require CGI; | |
8 require CGI::Cookie; | |
9 | |
58 | 10 use Carp; |
63
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
59
diff
changeset
|
11 use Encode; |
57 | 12 use IMPL::Class::Property; |
13 | |
63
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
59
diff
changeset
|
14 #todo: add binary method to set a binary encoding, set it automatic when type isn't a text |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
59
diff
changeset
|
15 |
57 | 16 BEGIN { |
67 | 17 # автозаполнение буде происходить в порядке объявления |
57 | 18 public property query => prop_get | owner_set; # cgi query |
19 public property status => prop_all, { validator => \&_checkHeaderPrinted }; | |
20 public property contentType => prop_all, { validator => \&_checkHeaderPrinted }; # String | |
58 | 21 public property charset => { get => \&_charset, set => \&_charset }, { validator => \&_checkHeaderPrinted }; |
57 | 22 public property expires => prop_all, { validator => \&_checkHeaderPrinted }; |
23 public property cookies => prop_all, { validator => \&_checkHeaderPrinted }; # Hash | |
24 | |
58 | 25 public property buffered => prop_all, { validator => \&_canChangeBuffer }; # Boolean |
57 | 26 public property streamOut => prop_get | owner_set; # stream |
27 public property streamBody => {get => \&getStreamBody }; # stream | |
58 | 28 public property isHeaderPrinted => prop_get | owner_set; # Boolean |
57 | 29 |
30 private property _bufferBody => prop_all; | |
31 private property _streamBody => prop_all; | |
32 } | |
33 | |
34 __PACKAGE__->PassThroughArgs; | |
35 | |
67 | 36 our %CTOR = ( |
37 'IMPL::Object::Autofill' => sub { | |
38 my %args = @_; | |
39 | |
40 $args{query} = CGI->new($args{query} || {}); | |
41 | |
42 %args; | |
43 } | |
44 ); | |
45 | |
57 | 46 sub CTOR { |
47 my ($this,%args) = @_; | |
48 | |
65 | 49 if (lc $this->streamOut eq 'memory') { |
50 my $dummy = ''; | |
51 open my $hout, '>:encoding(utf8)', \$dummy or die new IMPL::Exception("Failed to create memory stream",$!); | |
52 $this->streamOut($hout); | |
53 } elsif (not $this->streamOut) { | |
54 $this->streamOut(*STDOUT); | |
55 } else { | |
56 die new IMPL::InvalidArgumentException("Invalid parameter value",$this->streamOut); | |
57 } | |
58 | |
63
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
59
diff
changeset
|
59 $this->buffered(1) unless defined $this->buffered; |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
59
diff
changeset
|
60 binmode $this->streamOut, ":encoding(".$this->charset.")"; |
57 | 61 } |
62 | |
63 sub _checkHeaderPrinted { | |
64 my ($this,$value) = @_; | |
65 | |
66 die new IMPL::InvalidOperationException() if $this->isHeaderPrinted; | |
67 } | |
68 | |
58 | 69 sub _canChangeBuffer { |
70 my ($this,$value) = @_; | |
71 | |
72 die new IMPL::InvalidOperationException() if $this->isHeaderPrinted or $this->_streamBody; | |
73 } | |
74 | |
75 sub _charset { | |
76 my $this = shift; | |
77 | |
63
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
59
diff
changeset
|
78 if (@_) { |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
59
diff
changeset
|
79 my $charset = $this->query->charset(@_); |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
59
diff
changeset
|
80 |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
59
diff
changeset
|
81 my $hout = $this->streamOut; |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
59
diff
changeset
|
82 |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
59
diff
changeset
|
83 binmode $hout; |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
59
diff
changeset
|
84 binmode $hout, ":encoding($charset)"; |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
59
diff
changeset
|
85 |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
59
diff
changeset
|
86 return $charset; |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
59
diff
changeset
|
87 } else { |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
59
diff
changeset
|
88 return $this->query->charset; |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
59
diff
changeset
|
89 } |
58 | 90 } |
91 | |
57 | 92 sub _PrintHeader { |
93 my ($this) = @_; | |
94 | |
95 unless ($this->isHeaderPrinted) { | |
96 $this->isHeaderPrinted(1); | |
97 | |
98 my %opt; | |
99 | |
100 $opt{-type} = $this->contentType if $this->contentType; | |
101 $opt{-status} = $this->status if $this->status; | |
102 $opt{-expires} = $this->expires if $this->expires; | |
103 | |
104 my $refCookies = $this->cookies; | |
105 $opt{-cookie} = [map CGI::Cookie->new(-name => $_, $refCookies->{$_} ), keys %$refCookies] if $refCookies; | |
106 | |
107 my $hOut = $this->streamOut; | |
108 | |
109 print $hOut $this->query->header( | |
110 %opt | |
111 ); | |
112 } | |
113 } | |
114 | |
115 sub getStreamBody { | |
116 my ($this) = @_; | |
117 | |
58 | 118 return undef unless $this->streamOut; |
57 | 119 |
58 | 120 unless ($this->_streamBody) { |
121 if ($this->buffered) { | |
122 my $buffer = ""; | |
63
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
59
diff
changeset
|
123 |
58 | 124 $this->_bufferBody(\$buffer); |
125 | |
63
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
59
diff
changeset
|
126 open my $hBody, ">:encoding(utf-8)", \$buffer or die new IMPL::Exception("Failed to create buffer",$!); |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
59
diff
changeset
|
127 |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
59
diff
changeset
|
128 Encode::_utf8_on($buffer); |
58 | 129 |
130 $this->_streamBody($hBody); | |
131 } else { | |
132 $this->_PrintHeader(); | |
133 $this->_streamBody($this->streamOut); | |
134 } | |
57 | 135 } |
58 | 136 |
137 return $this->_streamBody; | |
57 | 138 } |
139 | |
140 sub Complete { | |
141 my ($this) = @_; | |
142 | |
143 return 0 unless $this->streamOut; | |
144 | |
145 my $hOut = $this->streamOut; | |
146 | |
147 $this->_PrintHeader(); | |
148 | |
63
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
59
diff
changeset
|
149 $this->_streamBody(undef); |
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
59
diff
changeset
|
150 |
57 | 151 if ($this->buffered) { |
152 print $hOut ${$this->_bufferBody}; | |
63
76b878ad6596
Added serialization support for the IMPL::Object::List
wizard
parents:
59
diff
changeset
|
153 } |
57 | 154 |
155 $this->_bufferBody(undef); | |
156 $this->streamOut(undef); | |
157 | |
158 return 1; | |
159 } | |
160 | |
161 sub Discard { | |
162 my ($this) = @_; | |
163 | |
58 | 164 carp "Discarding sent response" if $this->isHeaderPrinted; |
165 | |
57 | 166 $this->_streamBody(undef); |
167 $this->_bufferBody(undef); | |
168 $this->streamOut(undef); | |
169 } | |
170 | |
171 1; | |
172 | |
173 __END__ | |
174 | |
175 =pod | |
176 | |
67 | 177 =head1 NAME |
178 | |
179 C<IMPL::Web::Application::Response> - Ответ веб сервера непосредственно клиенту. | |
180 | |
58 | 181 =head1 DESCRIPTION |
57 | 182 |
67 | 183 C<[Infrastructure]> |
184 | |
185 Позволяет сформировать основные свойства заголовка и тело ответа. | |
186 | |
187 Создается объектом C<IMPL::Web::Application::Action> в процессе обработки запроса. | |
188 | |
189 Может использоваться обработчиками C<IMPL::Web::QueryHandler> в процессе выполнения запроса. | |
58 | 190 |
191 Объект позволяет буфферизировать вывод в тело ответа, что позволяет отменить или изменить | |
67 | 192 ответ в последний момент. Свойство C< isHeaderPrinted > используется для определения факта |
193 отправлки данных клиенту. | |
58 | 194 |
195 =head1 PROPERTIES | |
196 | |
197 =head2 HTTP Header | |
198 | |
199 Свойства отвечающие за заголовок HTTP ответа. Эти своства могут быть изменены до тех пор пока | |
200 не будет отправлен заголовок. В противном случае выдается исключение C< IMPL::InvalidOperationException >. | |
201 | |
202 =over | |
203 | |
67 | 204 =item C< [get] query > |
58 | 205 |
206 CGI запрос, который используется для вывода данных, заголовка и пр. Существует всегда. | |
207 | |
67 | 208 =item C< [get,set] status > |
58 | 209 |
210 Код ошибки HTTP. Например, '200 OK'. По умолчанию не установлен, при отправке клиенту бедт отправлен '200 ОК'. | |
211 | |
67 | 212 =item C< [get,set] contentType > |
58 | 213 |
214 Тип MIME. По умолчанию не установлен, подразумивается 'text/html'. | |
215 | |
67 | 216 =item C< [get,set] charset > |
58 | 217 |
218 Кодировка, синоним свойства query->charset. | |
219 | |
67 | 220 =item C< [get,set] expires > |
58 | 221 |
222 Определяет время жизни контента, например '+10m'. По умолчанию не задано и не передается. | |
223 | |
67 | 224 =item C< [get,set] cookies > |
58 | 225 |
226 Хеш массив с cookies, например C< { cart => ['foo','bar'], display => 'list' } >. | |
227 | |
228 =back | |
229 | |
230 =head2 Response behaviour | |
231 | |
232 Свойства отвечающие за поведение ответа. | |
233 | |
234 =over | |
235 | |
67 | 236 =item C< [get,set] buffered > |
58 | 237 |
238 C< True > - то тело ответа пишется в буффер и будет отправлено при вызове метода C< Complete >, | |
239 заголовок также будет отправлен после вызова метода C< Complete >. | |
240 | |
241 C< False > - тело ответа пишется непосредственно в поток к клиенту, при этом заголовок | |
242 будет отправлен при первом обращении к свойству C< streamBody > | |
243 | |
244 Это свойство можно менять до первого обращения к потоку для записи в тело ответа. | |
245 | |
67 | 246 =item C< [get] streamOut > |
58 | 247 |
248 Стандартный вывод CGI приложения. | |
249 | |
67 | 250 =item C< [get] streamBody > |
58 | 251 |
252 Поток для записи в тело ответа. | |
253 | |
67 | 254 =item C< [get] isHeadPrinted > |
58 | 255 |
256 Признак того, что заголовок уже был отправлен клиенту. | |
257 | |
258 =back | |
259 | |
260 =head1 METHODS | |
261 | |
262 =over | |
263 | |
264 =item C< Complete > | |
265 | |
266 Завершает отправку ответа. | |
267 | |
268 =item C< Discard > | |
269 | |
270 Отменяет отправку ответа, при этом если часть данных (например, заголовок) | |
271 уже была отправлена, выдает предупреждение в STDERR. | |
272 | |
273 =back | |
57 | 274 |
67 | 275 =head1 REMARKS |
276 | |
277 Данный объект является автозаполняемым, т.е. все его свойства можно задать через | |
278 именованные параметры конструктора. | |
279 | |
57 | 280 =cut |